diff --git a/basis/cocoa/views/views-docs.factor b/basis/cocoa/views/views-docs.factor index 3b533f98c3..871326fcd4 100644 --- a/basis/cocoa/views/views-docs.factor +++ b/basis/cocoa/views/views-docs.factor @@ -1,13 +1,9 @@ -USING: help.syntax help.markup ; +USING: help.syntax help.markup ui.pixel-formats ; IN: cocoa.views -HELP: -{ $values { "attributes" "a sequence of attributes" } { "pixelfmt" "an " { $snippet "NSOpenGLPixelFormat" } } } -{ $description "Creates an " { $snippet "NSOpenGLPixelFormat" } " with some reasonable defaults." } ; - HELP: -{ $values { "class" "an subclass of " { $snippet "NSOpenGLView" } } { "dim" "a pair of real numbers" } { "view" "a new " { $snippet "NSOpenGLView" } } } -{ $description "Creates a new instance of the specified class, giving it a default pixel format and the given size." } ; +{ $values { "class" "an subclass of " { $snippet "NSOpenGLView" } } { "dim" "a pair of real numbers" } { "pixel-format" pixel-format } { "view" "a new " { $snippet "NSOpenGLView" } } } +{ $description "Creates a new instance of the specified class, giving it the specified pixel format and size." } ; HELP: view-dim { $values { "view" "an " { $snippet "NSView" } } { "dim" "a pair of real numbers" } } @@ -18,7 +14,6 @@ HELP: mouse-location { $description "Outputs the current mouse location." } ; ARTICLE: "cocoa-view-utils" "Cocoa view utilities" -{ $subsection } { $subsection } { $subsection view-dim } { $subsection mouse-location } ; diff --git a/basis/cocoa/views/views.factor b/basis/cocoa/views/views.factor index 3c60a6a7c1..f65fddac58 100644 --- a/basis/cocoa/views/views.factor +++ b/basis/cocoa/views/views.factor @@ -42,39 +42,10 @@ CONSTANT: NSOpenGLPFAAllowOfflineRenderers 96 CONSTANT: NSOpenGLPFAVirtualScreenCount 128 CONSTANT: NSOpenGLCPSwapInterval 222 - - -: with-software-renderer ( quot -- ) - [ t software-renderer? ] dip with-variable ; inline - -: with-multisample ( quot -- ) - [ t multisample? ] dip with-variable ; inline - -: ( attributes -- pixelfmt ) - NSOpenGLPixelFormat -> alloc swap [ - % - NSOpenGLPFADepthSize , 16 , - software-renderer? get [ - NSOpenGLPFARendererID , kCGLRendererGenericFloatID , - ] when - multisample? get [ - NSOpenGLPFASupersample , - NSOpenGLPFASampleBuffers , 1 , - NSOpenGLPFASamples , 8 , - ] when - 0 , - ] int-array{ } make - -> initWithAttributes: - -> autorelease ; - -: ( class dim -- view ) - [ -> alloc 0 0 ] dip first2 - NSOpenGLPFAWindow NSOpenGLPFADoubleBuffer 2array +: ( class dim pixel-format -- view ) + [ -> alloc ] + [ [ 0 0 ] dip first2 ] + [ handle>> ] tri* -> initWithFrame:pixelFormat: dup 1 -> setPostsBoundsChangedNotifications: dup 1 -> setPostsFrameChangedNotifications: ; diff --git a/basis/delegate/delegate-docs.factor b/basis/delegate/delegate-docs.factor index 42b727852e..42e770aa75 100644 --- a/basis/delegate/delegate-docs.factor +++ b/basis/delegate/delegate-docs.factor @@ -24,7 +24,7 @@ HELP: CONSULT: HELP: SLOT-PROTOCOL: { $syntax "SLOT-PROTOCOL: protocol-name slots... ;" } -{ $description "Defines a protocol consisting of reader and writer words for the listen slot names." } ; +{ $description "Defines a protocol consisting of reader and writer words for the listed slot names." } ; { define-protocol POSTPONE: PROTOCOL: } related-words diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor index b500d9f5ca..03bd21e58c 100644 --- a/basis/functors/functors-tests.factor +++ b/basis/functors/functors-tests.factor @@ -81,7 +81,26 @@ SYMBOL: W [ blorgh ] [ blorgh ] unit-test -GENERIC: some-generic ( a -- b ) +<< + +FUNCTOR: generic-test ( W -- ) + +W DEFINES ${W} + +WHERE + +GENERIC: W ( a -- b ) +M: object W ; +M: integer W 1 + ; + +;FUNCTOR + +"snurv" generic-test + +>> + +[ 2 ] [ 1 snurv ] unit-test +[ 3.0 ] [ 3.0 snurv ] unit-test ! Does replacing an ordinary word with a functor-generated one work? [ [ ] ] [ @@ -89,6 +108,7 @@ GENERIC: some-generic ( a -- b ) TUPLE: some-tuple ; : some-word ( -- ) ; + GENERIC: some-generic ( a -- b ) M: some-tuple some-generic ; SYMBOL: some-symbol "> "functors-test" parse-stream @@ -97,6 +117,7 @@ GENERIC: some-generic ( a -- b ) : test-redefinition ( -- ) [ t ] [ "some-word" "functors.tests" lookup >boolean ] unit-test [ t ] [ "some-tuple" "functors.tests" lookup >boolean ] unit-test + [ t ] [ "some-generic" "functors.tests" lookup >boolean ] unit-test [ t ] [ "some-tuple" "functors.tests" lookup "some-generic" "functors.tests" lookup method >boolean @@ -109,13 +130,14 @@ FUNCTOR: redefine-test ( W -- ) W-word DEFINES ${W}-word W-tuple DEFINES-CLASS ${W}-tuple -W-generic IS ${W}-generic +W-generic DEFINES ${W}-generic W-symbol DEFINES ${W}-symbol WHERE TUPLE: W-tuple ; : W-word ( -- ) ; +GENERIC: W-generic ( a -- b ) M: W-tuple W-generic ; SYMBOL: W-symbol diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index ce069ac953..edd4932c66 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel quotations classes.tuple make combinators generic -words interpolate namespaces sequences io.streams.string fry -classes.mixin effects lexer parser classes.tuple.parser -effects.parser locals.types locals.parser generic.parser -locals.rewrite.closures vocabs.parser classes.parser -arrays accessors words.symbol ; +USING: accessors arrays classes.mixin classes.parser +classes.tuple classes.tuple.parser combinators effects +effects.parser fry generic generic.parser generic.standard +interpolate io.streams.string kernel lexer locals.parser +locals.rewrite.closures locals.types make namespaces parser +quotations sequences vocabs.parser words words.symbol ; IN: functors ! This is a hack @@ -18,6 +18,8 @@ IN: functors : define-declared* ( word def effect -- ) pick set-word define-declared ; +: define-simple-generic* ( word effect -- ) over set-word define-simple-generic ; + TUPLE: fake-call-next-method ; TUPLE: fake-quotation seq ; @@ -104,6 +106,11 @@ SYNTAX: `INSTANCE: scan-param parsed \ add-mixin-instance parsed ; +SYNTAX: `GENERIC: + scan-param parsed + complete-effect parsed + \ define-simple-generic* parsed ; + SYNTAX: `inline [ word make-inline ] over push-all ; SYNTAX: `call-next-method T{ fake-call-next-method } parsed ; @@ -130,6 +137,7 @@ DEFER: ;FUNCTOR delimiter { "M:" POSTPONE: `M: } { "C:" POSTPONE: `C: } { ":" POSTPONE: `: } + { "GENERIC:" POSTPONE: `GENERIC: } { "INSTANCE:" POSTPONE: `INSTANCE: } { "SYNTAX:" POSTPONE: `SYNTAX: } { "SYMBOL:" POSTPONE: `SYMBOL: } diff --git a/extra/literals/authors.txt b/basis/literals/authors.txt similarity index 100% rename from extra/literals/authors.txt rename to basis/literals/authors.txt diff --git a/extra/literals/literals-docs.factor b/basis/literals/literals-docs.factor similarity index 100% rename from extra/literals/literals-docs.factor rename to basis/literals/literals-docs.factor diff --git a/extra/literals/literals-tests.factor b/basis/literals/literals-tests.factor similarity index 100% rename from extra/literals/literals-tests.factor rename to basis/literals/literals-tests.factor diff --git a/extra/literals/literals.factor b/basis/literals/literals.factor similarity index 100% rename from extra/literals/literals.factor rename to basis/literals/literals.factor diff --git a/extra/literals/summary.txt b/basis/literals/summary.txt similarity index 100% rename from extra/literals/summary.txt rename to basis/literals/summary.txt diff --git a/extra/literals/tags.txt b/basis/literals/tags.txt similarity index 100% rename from extra/literals/tags.txt rename to basis/literals/tags.txt diff --git a/basis/math/rectangles/rectangles-tests.factor b/basis/math/rectangles/rectangles-tests.factor index ca722859d2..7959d98f92 100644 --- a/basis/math/rectangles/rectangles-tests.factor +++ b/basis/math/rectangles/rectangles-tests.factor @@ -1,42 +1,42 @@ USING: tools.test math.rectangles ; IN: math.rectangles.tests -[ T{ rect f { 10 10 } { 20 20 } } ] +[ RECT: { 10 10 } { 20 20 } ] [ - T{ rect f { 10 10 } { 50 50 } } - T{ rect f { -10 -10 } { 40 40 } } + RECT: { 10 10 } { 50 50 } + RECT: { -10 -10 } { 40 40 } rect-intersect ] unit-test -[ T{ rect f { 200 200 } { 0 0 } } ] +[ RECT: { 200 200 } { 0 0 } ] [ - T{ rect f { 100 100 } { 50 50 } } - T{ rect f { 200 200 } { 40 40 } } + RECT: { 100 100 } { 50 50 } + RECT: { 200 200 } { 40 40 } rect-intersect ] unit-test [ f ] [ - T{ rect f { 100 100 } { 50 50 } } - T{ rect f { 200 200 } { 40 40 } } + RECT: { 100 100 } { 50 50 } + RECT: { 200 200 } { 40 40 } contains-rect? ] unit-test [ t ] [ - T{ rect f { 100 100 } { 50 50 } } - T{ rect f { 120 120 } { 40 40 } } + RECT: { 100 100 } { 50 50 } + RECT: { 120 120 } { 40 40 } contains-rect? ] unit-test [ f ] [ - T{ rect f { 1000 100 } { 50 50 } } - T{ rect f { 120 120 } { 40 40 } } + RECT: { 1000 100 } { 50 50 } + RECT: { 120 120 } { 40 40 } contains-rect? ] unit-test -[ T{ rect f { 10 20 } { 20 20 } } ] [ +[ RECT: { 10 20 } { 20 20 } ] [ { { 20 20 } { 10 40 } { 30 30 } } rect-containing -] unit-test \ No newline at end of file +] unit-test diff --git a/basis/math/rectangles/rectangles.factor b/basis/math/rectangles/rectangles.factor index 1d9c91328f..90174d144e 100644 --- a/basis/math/rectangles/rectangles.factor +++ b/basis/math/rectangles/rectangles.factor @@ -1,12 +1,18 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel arrays sequences math math.vectors accessors ; +USING: kernel arrays sequences math math.vectors accessors +parser prettyprint.custom prettyprint.backend ; IN: math.rectangles TUPLE: rect { loc initial: { 0 0 } } { dim initial: { 0 0 } } ; : ( loc dim -- rect ) rect boa ; inline +SYNTAX: RECT: scan-object scan-object parsed ; + +M: rect pprint* + \ RECT: [ [ loc>> ] [ dim>> ] bi [ pprint* ] bi@ ] pprint-prefix ; + : ( -- rect ) rect new ; inline : point>rect ( loc -- rect ) { 0 0 } ; inline @@ -55,4 +61,4 @@ M: rect contains-point? : set-rect-bounds ( rect1 rect -- ) [ [ loc>> ] dip (>>loc) ] [ [ dim>> ] dip (>>dim) ] - 2bi ; inline \ No newline at end of file + 2bi ; inline diff --git a/basis/opengl/gl/windows/windows.factor b/basis/opengl/gl/windows/windows.factor index 8f48f60d3c..c8a179edf5 100644 --- a/basis/opengl/gl/windows/windows.factor +++ b/basis/opengl/gl/windows/windows.factor @@ -1,6 +1,11 @@ -USING: kernel windows.opengl32 ; +USING: alien.syntax kernel windows.types ; IN: opengl.gl.windows +LIBRARY: gl + +FUNCTION: HGLRC wglGetCurrentContext ( ) ; +FUNCTION: void* wglGetProcAddress ( char* name ) ; + : gl-function-context ( -- context ) wglGetCurrentContext ; inline : gl-function-address ( name -- address ) wglGetProcAddress ; inline : gl-function-calling-convention ( -- str ) "stdcall" ; inline diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor index 362305c8f7..5b1b4b0c2a 100755 --- a/basis/ui/backend/cocoa/cocoa.factor +++ b/basis/ui/backend/cocoa/cocoa.factor @@ -1,14 +1,16 @@ ! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors math arrays assocs cocoa cocoa.application -command-line kernel memory namespaces cocoa.messages -cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types -cocoa.windows cocoa.classes cocoa.nibs sequences ui ui.private -ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds -ui.backend.cocoa.views core-foundation core-foundation.run-loop -core-graphics.types threads math.rectangles fry libc -generalizations alien.c-types cocoa.views -combinators io.thread locals ; +USING: accessors alien.c-types arrays assocs classes cocoa +cocoa.application cocoa.classes cocoa.messages cocoa.nibs +cocoa.pasteboard cocoa.runtime cocoa.subclassing cocoa.types +cocoa.views cocoa.windows combinators command-line +core-foundation core-foundation.run-loop core-graphics +core-graphics.types destructors fry generalizations io.thread +kernel libc literals locals math math.rectangles memory +namespaces sequences specialized-arrays.int threads ui +ui.backend ui.backend.cocoa.views ui.clipboards ui.gadgets +ui.gadgets.worlds ui.pixel-formats ui.pixel-formats.private +ui.private words.symbol ; IN: ui.backend.cocoa TUPLE: handle ; @@ -20,6 +22,42 @@ C: offscreen-handle SINGLETON: cocoa-ui-backend +PIXEL-FORMAT-ATTRIBUTE-TABLE: NSOpenGLPFA { } H{ + { double-buffered { $ NSOpenGLPFADoubleBuffer } } + { stereo { $ NSOpenGLPFAStereo } } + { offscreen { $ NSOpenGLPFAOffScreen } } + { fullscreen { $ NSOpenGLPFAFullScreen } } + { windowed { $ NSOpenGLPFAWindow } } + { accelerated { $ NSOpenGLPFAAccelerated } } + { software-rendered { $ NSOpenGLPFASingleRenderer $ kCGLRendererGenericFloatID } } + { backing-store { $ NSOpenGLPFABackingStore } } + { multisampled { $ NSOpenGLPFAMultisample } } + { supersampled { $ NSOpenGLPFASupersample } } + { sample-alpha { $ NSOpenGLPFASampleAlpha } } + { color-float { $ NSOpenGLPFAColorFloat } } + { color-bits { $ NSOpenGLPFAColorSize } } + { alpha-bits { $ NSOpenGLPFAAlphaSize } } + { accum-bits { $ NSOpenGLPFAAccumSize } } + { depth-bits { $ NSOpenGLPFADepthSize } } + { stencil-bits { $ NSOpenGLPFAStencilSize } } + { aux-buffers { $ NSOpenGLPFAAuxBuffers } } + { sample-buffers { $ NSOpenGLPFASampleBuffers } } + { samples { $ NSOpenGLPFASamples } } +} + +M: cocoa-ui-backend (make-pixel-format) + nip >NSOpenGLPFA-int-array + NSOpenGLPixelFormat -> alloc swap -> initWithAttributes: ; + +M: cocoa-ui-backend (free-pixel-format) + handle>> -> release ; + +M: cocoa-ui-backend (pixel-format-attribute) + [ handle>> ] [ >NSOpenGLPFA ] bi* + [ drop f ] + [ first 0 [ swap 0 -> getValues:forAttribute:forVirtualScreen: ] keep *int ] + if-empty ; + TUPLE: pasteboard handle ; C: pasteboard @@ -70,7 +108,8 @@ M: cocoa-ui-backend fullscreen* ( world -- ? ) handle>> view>> -> isInFullScreenMode zero? not ; M:: cocoa-ui-backend (open-window) ( world -- ) - world dim>> :> view + world [ [ dim>> ] dip ] + with-world-pixel-format :> view view world world>NSRect :> window view -> release world view register-window @@ -97,18 +136,19 @@ M: cocoa-ui-backend raise-window* ( world -- ) ] when* ; : pixel-size ( pixel-format -- size ) - 0 [ NSOpenGLPFAColorSize 0 -> getValues:forAttribute:forVirtualScreen: ] - keep *int -3 shift ; + color-bits pixel-format-attribute -3 shift ; : offscreen-buffer ( world pixel-format -- alien w h pitch ) [ dim>> first2 ] [ pixel-size ] bi* { [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } 3cleave ; -: gadget-offscreen-context ( world -- context buffer ) - NSOpenGLPFAOffScreen 1array - [ nip NSOpenGLContext -> alloc swap f -> initWithFormat:shareContext: dup ] - [ offscreen-buffer ] 2bi - 4 npick [ -> setOffScreen:width:height:rowbytes: ] dip ; +:: gadget-offscreen-context ( world -- context buffer ) + world [ + nip :> pf + NSOpenGLContext -> alloc pf handle>> f -> initWithFormat:shareContext: + dup world pf offscreen-buffer + 4 npick [ -> setOffScreen:width:height:rowbytes: ] dip + ] with-world-pixel-format ; M: cocoa-ui-backend (open-offscreen-buffer) ( world -- ) dup gadget-offscreen-context >>handle drop ; diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor index 602c9bec73..4a16e3bd37 100644 --- a/basis/ui/backend/cocoa/views/views.factor +++ b/basis/ui/backend/cocoa/views/views.factor @@ -365,8 +365,8 @@ CLASS: { -> openGLContext -> CGLContextObj NSOpenGLCPSwapInterval 1 CGLSetParameter drop ; -: ( dim -- view ) - FactorView swap [ sync-refresh-to-screen ] keep ; +: ( dim pixel-format -- view ) + [ FactorView ] 2dip [ sync-refresh-to-screen ] keep ; : save-position ( world window -- ) -> frame CGRect-top-left 2array >>window-loc drop ; diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 76c0dc4e01..24ae72740f 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -10,11 +10,161 @@ windows.messages windows.types windows.offscreen windows.nt threads libc combinators fry combinators.short-circuit continuations command-line shuffle opengl ui.render ascii math.bitwise locals accessors math.rectangles math.order ascii calendar -io.encodings.utf16n windows.errors ; +io.encodings.utf16n windows.errors literals ui.pixel-formats +ui.pixel-formats.private memoize classes ; IN: ui.backend.windows SINGLETON: windows-ui-backend +TUPLE: win-base hDC hRC ; +TUPLE: win < win-base hWnd world title ; +TUPLE: win-offscreen < win-base hBitmap bits ; +C: win +C: win-offscreen + +> hDC>> (has-wglChoosePixelFormatARB?) ; + +: arb-make-pixel-format ( world attributes -- pf ) + [ handle>> hDC>> ] dip >WGL_ARB-int-array f 1 0 0 + [ wglChoosePixelFormatARB win32-error=0/f ] 2keep drop *int ; + +: arb-pixel-format-attribute ( pixel-format attribute -- value ) + >WGL_ARB + [ drop f ] [ + [ [ world>> handle>> hDC>> ] [ handle>> ] bi 0 1 ] dip + first 0 + [ wglGetPixelFormatAttribivARB win32-error=0/f ] + keep *int + ] if-empty ; + +CONSTANT: pfd-flag-map H{ + { double-buffered $ PFD_DOUBLEBUFFER } + { stereo $ PFD_STEREO } + { offscreen $ PFD_DRAW_TO_BITMAP } + { fullscreen $ PFD_DRAW_TO_WINDOW } + { windowed $ PFD_DRAW_TO_WINDOW } + { backing-store $ PFD_SWAP_COPY } + { software-rendered $ PFD_GENERIC_FORMAT } +} + +: >pfd-flag ( attribute -- value ) + pfd-flag-map at [ ] [ 0 ] if* ; + +: >pfd-flags ( attributes -- flags ) + [ >pfd-flag ] [ bitor ] map-reduce + PFD_SUPPORT_OPENGL bitor ; + +: attr-value ( attributes name -- value ) + [ instance? ] curry find nip + [ value>> ] [ 0 ] if* ; + +: >pfd ( attributes -- pfd ) + "PIXELFORMATDESCRIPTOR" + "PIXELFORMATDESCRIPTOR" heap-size over set-PIXELFORMATDESCRIPTOR-nSize + 1 over set-PIXELFORMATDESCRIPTOR-nVersion + over >pfd-flags over set-PIXELFORMATDESCRIPTOR-dwFlags + PFD_TYPE_RGBA over set-PIXELFORMATDESCRIPTOR-iPixelType + over color-bits attr-value over set-PIXELFORMATDESCRIPTOR-cColorBits + over red-bits attr-value over set-PIXELFORMATDESCRIPTOR-cRedBits + over green-bits attr-value over set-PIXELFORMATDESCRIPTOR-cGreenBits + over blue-bits attr-value over set-PIXELFORMATDESCRIPTOR-cBlueBits + over alpha-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAlphaBits + over accum-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumBits + over accum-red-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumRedBits + over accum-green-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumGreenBits + over accum-blue-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumBlueBits + over accum-alpha-bits attr-value over set-PIXELFORMATDESCRIPTOR-cAccumAlphaBits + over depth-bits attr-value over set-PIXELFORMATDESCRIPTOR-cDepthBits + over stencil-bits attr-value over set-PIXELFORMATDESCRIPTOR-cStencilBits + over aux-buffers attr-value over set-PIXELFORMATDESCRIPTOR-cAuxBuffers + PFD_MAIN_PLANE over set-PIXELFORMATDESCRIPTOR-dwLayerMask + nip ; + +: pfd-make-pixel-format ( world attributes -- pf ) + [ handle>> hDC>> ] [ >pfd ] bi* + ChoosePixelFormat dup win32-error=0/f ; + +: get-pfd ( pixel-format -- pfd ) + [ world>> handle>> hDC>> ] [ handle>> ] bi + "PIXELFORMATDESCRIPTOR" heap-size + "PIXELFORMATDESCRIPTOR" + [ DescribePixelFormat win32-error=0/f ] keep ; + +: pfd-flag? ( pfd flag -- ? ) + [ PIXELFORMATDESCRIPTOR-dwFlags ] dip bitand c-bool> ; + +: (pfd-pixel-format-attribute) ( pfd attribute -- value ) + { + { double-buffered [ PFD_DOUBLEBUFFER pfd-flag? ] } + { stereo [ PFD_STEREO pfd-flag? ] } + { offscreen [ PFD_DRAW_TO_BITMAP pfd-flag? ] } + { fullscreen [ PFD_DRAW_TO_WINDOW pfd-flag? ] } + { windowed [ PFD_DRAW_TO_WINDOW pfd-flag? ] } + { software-rendered [ PFD_GENERIC_FORMAT pfd-flag? ] } + { color-bits [ PIXELFORMATDESCRIPTOR-cColorBits ] } + { red-bits [ PIXELFORMATDESCRIPTOR-cRedBits ] } + { green-bits [ PIXELFORMATDESCRIPTOR-cGreenBits ] } + { blue-bits [ PIXELFORMATDESCRIPTOR-cBlueBits ] } + { alpha-bits [ PIXELFORMATDESCRIPTOR-cAlphaBits ] } + { accum-bits [ PIXELFORMATDESCRIPTOR-cAccumBits ] } + { accum-red-bits [ PIXELFORMATDESCRIPTOR-cAccumRedBits ] } + { accum-green-bits [ PIXELFORMATDESCRIPTOR-cAccumGreenBits ] } + { accum-blue-bits [ PIXELFORMATDESCRIPTOR-cAccumBlueBits ] } + { accum-alpha-bits [ PIXELFORMATDESCRIPTOR-cAccumAlphaBits ] } + { depth-bits [ PIXELFORMATDESCRIPTOR-cDepthBits ] } + { stencil-bits [ PIXELFORMATDESCRIPTOR-cStencilBits ] } + { aux-buffers [ PIXELFORMATDESCRIPTOR-cAuxBuffers ] } + [ 2drop f ] + } case ; + +: pfd-pixel-format-attribute ( pixel-format attribute -- value ) + [ get-pfd ] dip (pfd-pixel-format-attribute) ; + +M: windows-ui-backend (make-pixel-format) + over has-wglChoosePixelFormatARB? + [ arb-make-pixel-format ] [ pfd-make-pixel-format ] if ; + +M: windows-ui-backend (free-pixel-format) + drop ; + +M: windows-ui-backend (pixel-format-attribute) + over world>> has-wglChoosePixelFormatARB? + [ arb-pixel-format-attribute ] [ pfd-pixel-format-attribute ] if ; + +PRIVATE> + : lo-word ( wparam -- lo ) *short ; inline : hi-word ( wparam -- hi ) -16 shift lo-word ; inline : >lo-hi ( WORD -- array ) [ lo-word ] [ hi-word ] bi 2array ; @@ -73,12 +223,6 @@ M: pasteboard set-clipboard-contents drop copy ; clipboard set-global selection set-global ; -TUPLE: win-base hDC hRC ; -TUPLE: win < win-base hWnd world title ; -TUPLE: win-offscreen < win-base hBitmap bits ; -C: win -C: win-offscreen - SYMBOLS: msg-obj class-name-ptr mouse-captured ; : style ( -- n ) WS_OVERLAPPEDWINDOW ; inline @@ -477,25 +621,24 @@ M: windows-ui-backend do-events f class-name-ptr set-global f msg-obj set-global ; -: setup-pixel-format ( hdc flags -- ) - 32 make-pfd [ ChoosePixelFormat dup win32-error=0/f ] 2keep - swapd SetPixelFormat win32-error=0/f ; +: get-dc ( world -- ) handle>> dup hWnd>> GetDC dup win32-error=0/f >>hDC drop ; -: get-dc ( hWnd -- hDC ) GetDC dup win32-error=0/f ; +: get-rc ( world -- ) + handle>> dup hDC>> dup wglCreateContext dup win32-error=0/f + [ wglMakeCurrent win32-error=0/f ] keep >>hRC drop ; -: get-rc ( hDC -- hRC ) - dup wglCreateContext dup win32-error=0/f - [ wglMakeCurrent win32-error=0/f ] keep ; +: set-pixel-format ( pixel-format hdc -- ) + swap handle>> "PIXELFORMATDESCRIPTOR" SetPixelFormat win32-error=0/f ; -: setup-gl ( hwnd -- hDC hRC ) - get-dc dup windowed-pfd-dwFlags setup-pixel-format dup get-rc ; +: setup-gl ( world -- ) + [ get-dc ] keep + [ swap [ handle>> hDC>> set-pixel-format ] [ get-rc ] bi ] + with-world-pixel-format ; M: windows-ui-backend (open-window) ( world -- ) - [ create-window [ setup-gl ] keep ] keep - [ f ] keep - [ swap hWnd>> register-window ] 2keep - dupd (>>handle) - hWnd>> show-window ; + [ dup create-window [ f f ] dip f f >>handle setup-gl ] + [ dup handle>> hWnd>> register-window ] + [ handle>> hWnd>> show-window ] tri ; M: win-base select-gl-context ( handle -- ) [ hDC>> ] [ hRC>> ] bi wglMakeCurrent win32-error=0/f @@ -504,15 +647,15 @@ M: win-base select-gl-context ( handle -- ) M: win-base flush-gl-context ( handle -- ) hDC>> SwapBuffers win32-error=0/f ; -: setup-offscreen-gl ( dim -- hDC hRC hBitmap bits ) - make-offscreen-dc-and-bitmap [ - [ dup offscreen-pfd-dwFlags setup-pixel-format ] - [ get-rc ] bi - ] 2dip ; +: setup-offscreen-gl ( world -- ) + dup [ handle>> ] [ dim>> ] bi make-offscreen-dc-and-bitmap + [ >>hDC ] [ >>hBitmap ] [ >>bits ] tri* drop [ + swap [ handle>> hDC>> set-pixel-format ] [ get-rc ] bi + ] with-world-pixel-format ; M: windows-ui-backend (open-offscreen-buffer) ( world -- ) - dup dim>> setup-offscreen-gl - >>handle drop ; + win-offscreen new >>handle + setup-offscreen-gl ; M: windows-ui-backend (close-offscreen-buffer) ( handle -- ) [ hDC>> DeleteDC drop ] diff --git a/basis/ui/backend/x11/x11.factor b/basis/ui/backend/x11/x11.factor index fb78abe917..76fd9fa30c 100755 --- a/basis/ui/backend/x11/x11.factor +++ b/basis/ui/backend/x11/x11.factor @@ -7,7 +7,8 @@ namespaces opengl sequences strings x11 x11.xlib x11.events x11.xim x11.glx x11.clipboard x11.constants x11.windows x11.io io.encodings.string io.encodings.ascii io.encodings.utf8 combinators command-line math.vectors classes.tuple opengl.gl threads -math.rectangles environment ascii ; +math.rectangles environment ascii literals +ui.pixel-formats ui.pixel-formats.private ; IN: ui.backend.x11 SINGLETON: x11-ui-backend @@ -29,6 +30,40 @@ M: world configure-event ! In case dimensions didn't change relayout-1 ; +PIXEL-FORMAT-ATTRIBUTE-TABLE: glx-visual { $ GLX_USE_GL $ GLX_RGBA } H{ + { double-buffered { $ GLX_DOUBLEBUFFER } } + { stereo { $ GLX_STEREO } } + { color-bits { $ GLX_BUFFER_SIZE } } + { red-bits { $ GLX_RED_SIZE } } + { green-bits { $ GLX_GREEN_SIZE } } + { blue-bits { $ GLX_BLUE_SIZE } } + { alpha-bits { $ GLX_ALPHA_SIZE } } + { accum-red-bits { $ GLX_ACCUM_RED_SIZE } } + { accum-green-bits { $ GLX_ACCUM_GREEN_SIZE } } + { accum-blue-bits { $ GLX_ACCUM_BLUE_SIZE } } + { accum-alpha-bits { $ GLX_ACCUM_ALPHA_SIZE } } + { depth-bits { $ GLX_DEPTH_SIZE } } + { stencil-bits { $ GLX_STENCIL_SIZE } } + { aux-buffers { $ GLX_AUX_BUFFERS } } + { sample-buffers { $ GLX_SAMPLE_BUFFERS } } + { samples { $ GLX_SAMPLES } } +} + +M: x11-ui-backend (make-pixel-format) + [ drop dpy get scr get ] dip + >glx-visual-int-array glXChooseVisual ; + +M: x11-ui-backend (free-pixel-format) + handle>> XFree ; + +M: x11-ui-backend (pixel-format-attribute) + [ dpy get ] 2dip + [ handle>> ] [ >glx-visual ] bi* + [ 2drop f ] [ + first + 0 [ glXGetConfig drop ] keep *int + ] if-empty ; + CONSTANT: modifiers { { S+ HEX: 1 } @@ -187,7 +222,8 @@ M: world client-event : gadget-window ( world -- ) dup - [ window-loc>> ] [ dim>> ] bi glx-window swap + [ [ [ window-loc>> ] [ dim>> ] bi ] dip handle>> glx-window ] + with-world-pixel-format swap dup "Factor" create-xic [ window>> register-window ] [ >>handle drop ] 2bi ; @@ -274,7 +310,9 @@ M: x11-pixmap-handle flush-gl-context ( handle -- ) drop ; M: x11-ui-backend (open-offscreen-buffer) ( world -- ) - dup dim>> glx-pixmap >>handle drop ; + dup [ [ dim>> ] [ handle>> ] bi* glx-pixmap ] + with-world-pixel-format + >>handle drop ; M: x11-ui-backend (close-offscreen-buffer) ( handle -- ) dpy get swap [ glx-pixmap>> glXDestroyGLXPixmap ] diff --git a/basis/ui/gadgets/worlds/worlds-docs.factor b/basis/ui/gadgets/worlds/worlds-docs.factor old mode 100644 new mode 100755 index e3c1226f22..9d4df189f2 --- a/basis/ui/gadgets/worlds/worlds-docs.factor +++ b/basis/ui/gadgets/worlds/worlds-docs.factor @@ -1,6 +1,6 @@ USING: ui.gadgets ui.render ui.text ui.text.private ui.gestures ui.backend help.markup help.syntax -models opengl strings ; +models opengl sequences strings ; IN: ui.gadgets.worlds HELP: user-input diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor old mode 100644 new mode 100755 index a186de7670..171272dfc1 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/basis/ui/gadgets/worlds/worlds.factor @@ -4,7 +4,7 @@ USING: accessors arrays assocs continuations kernel math models namespaces opengl opengl.textures sequences io combinators combinators.short-circuit fry math.vectors math.rectangles cache ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks -ui.commands ; +ui.commands ui.pixel-formats destructors ; IN: ui.gadgets.worlds TUPLE: world < track @@ -149,3 +149,14 @@ M: world handle-gesture ( gesture gadget -- ? ) : close-global ( world global -- ) [ get-global find-world eq? ] keep '[ f _ set-global ] when ; + +M: world world-pixel-format-attributes + drop + { windowed double-buffered T{ depth-bits { value 16 } } } ; + +M: world check-world-pixel-format + 2drop ; + +: with-world-pixel-format ( world quot -- ) + [ dup dup world-pixel-format-attributes ] + dip [ 2dup check-world-pixel-format ] prepose with-disposal ; inline diff --git a/basis/ui/pixel-formats/authors.txt b/basis/ui/pixel-formats/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/basis/ui/pixel-formats/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/basis/ui/pixel-formats/pixel-formats-docs.factor b/basis/ui/pixel-formats/pixel-formats-docs.factor new file mode 100644 index 0000000000..207b757908 --- /dev/null +++ b/basis/ui/pixel-formats/pixel-formats-docs.factor @@ -0,0 +1,198 @@ +USING: destructors help.markup help.syntax kernel math multiline sequences +vocabs vocabs.parser words ; +IN: ui.pixel-formats + +! break circular dependency +<< + "ui.gadgets.worlds" create-vocab drop + "world" "ui.gadgets.worlds" create drop + "ui.gadgets.worlds" (use+) +>> + +ARTICLE: "ui.pixel-formats-attributes" "Pixel format attributes" +"The following pixel format attributes can be requested and queried of " { $link pixel-format } "s. Binary attributes are represented by the presence of a symbol in an attribute sequence:" +{ $subsection double-buffered } +{ $subsection stereo } +{ $subsection offscreen } +{ $subsection fullscreen } +{ $subsection windowed } +{ $subsection accelerated } +{ $subsection software-rendered } +{ $subsection backing-store } +{ $subsection multisampled } +{ $subsection supersampled } +{ $subsection sample-alpha } +{ $subsection color-float } +"Integer attributes are represented by a " { $link tuple } " with a single " { $snippet "value" } "slot:" +{ $subsection color-bits } +{ $subsection red-bits } +{ $subsection green-bits } +{ $subsection blue-bits } +{ $subsection alpha-bits } +{ $subsection accum-bits } +{ $subsection accum-red-bits } +{ $subsection accum-green-bits } +{ $subsection accum-blue-bits } +{ $subsection accum-alpha-bits } +{ $subsection depth-bits } +{ $subsection stencil-bits } +{ $subsection aux-buffers } +{ $subsection sample-buffers } +{ $subsection samples } +{ $examples +"The following " { $link world } " subclass will request a double-buffered window with minimum 24-bit color and depth buffers, and will throw an error if the requirements aren't met:" +{ $code <" +USING: kernel ui.worlds ui.pixel-formats ; +IN: ui.pixel-formats.examples + +TUPLE: picky-depth-buffered-world < world ; + +M: picky-depth-buffered-world world-pixel-format-attributes + drop { + double-buffered + T{ color-bits { value 24 } } + T{ depth-bits { value 24 } } + } ; + +M: picky-depth-buffered-world check-world-pixel-format + nip + [ double-buffered pixel-format-attribute 0 = [ "Not double buffered!" throw ] when ] + [ color-bits pixel-format-attribute 24 < [ "Not enough color bits!" throw ] when ] + [ depth-bits pixel-format-attribute 24 < [ "Not enough depth bits!" throw ] when ] + tri ; +"> } } +; + +HELP: double-buffered +{ $class-description "Requests a double-buffered pixel format." } ; +HELP: stereo +{ $class-description "Requests a stereoscopic pixel format." } ; + +HELP: offscreen +{ $class-description "Requests a pixel format suitable for offscreen rendering." } ; +HELP: fullscreen +{ $class-description "Requests a pixel format suitable for fullscreen rendering." } +{ $notes "On some window systems this is not distinct from " { $link windowed } "." } ; +HELP: windowed +{ $class-description "Requests a pixel format suitable for rendering to a window." } ; + +{ offscreen fullscreen windowed } related-words + +HELP: accelerated +{ $class-description "Requests a pixel format supported by GPU hardware acceleration." } ; +HELP: software-rendered +{ $class-description "Requests a pixel format only supported by the window system's default software renderer." } ; + +{ accelerated software-rendered } related-words + +HELP: backing-store +{ $class-description "Used with " { $link double-buffered } " to request a double-buffered pixel format where the back buffer contents are preserved and copied to the front when buffers are swapped." } ; + +{ double-buffered backing-store } related-words + +HELP: multisampled +{ $class-description "Requests a pixel format with multisampled antialiasing enabled. The " { $link sample-buffers } " and " { $link samples } " attributes must also be specified to specify the level of multisampling." } +{ $notes "On some window systems this is not distinct from " { $link supersampled } "." } ; + +HELP: supersampled +{ $class-description "Requests a pixel format with supersampled antialiasing enabled. The " { $link sample-buffers } " and " { $link samples } " attributes must also be specified to specify the level of supersampling." } +{ $notes "On some window systems this is not distinct from " { $link multisampled } "." } ; + +HELP: sample-alpha +{ $class-description "Used with " { $link multisampled } " or " { $link supersampled } " to request more accurate multisampling of alpha values." } ; + +HELP: color-float +{ $class-description "Requests a pixel format where the pixels are stored in floating-point format." } ; + +HELP: color-bits +{ $class-description "Requests a pixel format of at least " { $snippet "value" } " bits per pixel." } ; +HELP: red-bits +{ $class-description "Requests a pixel format with at least " { $snippet "value" } " red bits per pixel." } ; +HELP: green-bits +{ $class-description "Requests a pixel format with at least " { $snippet "value" } " green bits per pixel." } ; +HELP: blue-bits +{ $class-description "Requests a pixel format with at least " { $snippet "value" } " blue bits per pixel." } ; +HELP: alpha-bits +{ $class-description "Requests a pixel format with at least " { $snippet "value" } " alpha bits per pixel." } ; + +{ color-float color-bits red-bits green-bits blue-bits alpha-bits } related-words + +HELP: accum-bits +{ $class-description "Requests a pixel format with an accumulation buffer of at least " { $snippet "value" } " bits per pixel." } ; +HELP: accum-red-bits +{ $class-description "Requests a pixel format with an accumulation buffer with at least " { $snippet "value" } " red bits per pixel." } ; +HELP: accum-green-bits +{ $class-description "Requests a pixel format with an accumulation buffer with at least " { $snippet "value" } " green bits per pixel." } ; +HELP: accum-blue-bits +{ $class-description "Requests a pixel format with an accumulation buffer with at least " { $snippet "value" } " blue bits per pixel." } ; +HELP: accum-alpha-bits +{ $class-description "Requests a pixel format with an accumulation buffer with at least " { $snippet "value" } " alpha bits per pixel." } ; + +{ accum-bits accum-red-bits accum-green-bits accum-blue-bits accum-alpha-bits } related-words + +HELP: depth-bits +{ $class-description "Requests a pixel format with a depth buffer of at least " { $snippet "value" } " bits per pixel." } ; + +HELP: stencil-bits +{ $class-description "Requests a pixel format with a stencil buffer of at least " { $snippet "value" } " bits per pixel." } ; + +HELP: aux-buffers +{ $class-description "Requests a pixel format with at least " { $snippet "value" } " auxiliary buffers." } ; + +HELP: sample-buffers +{ $class-description "Used with " { $link multisampled } " or " { $link supersampled } " to request a pixel format with at least " { $snippet "value" } " sampling buffers." } ; + +HELP: samples +{ $class-description "Used with " { $link multisampled } " or " { $link supersampled } " to request at least " { $snippet "value" } " samples per pixel." } ; + +{ multisampled supersampled sample-alpha sample-buffers samples } related-words + +HELP: world-pixel-format-attributes +{ $values { "world" world } { "attributes" sequence } } +{ $description "Returns the set of " { $link "ui.pixel-formats-attributes" } " that " { $snippet "world" } " requests when grafted. This generic can be overridden by subclasses of " { $snippet "world" } "." } +{ $notes "The pixel format provided by the window system will not necessarily exactly match the requested attributes. To verify required pixel format attributes, override " { $link check-world-pixel-format } "." } ; + +HELP: check-world-pixel-format +{ $values { "world" world } { "pixel-format" pixel-format } } +{ $description "Verifies that " { $snippet "pixel-format" } " fulfills the requirements of " { $snippet "world" } ". The default method does nothing. Subclasses can override this generic to perform their own checks on the pixel format." } ; + +HELP: pixel-format +{ $class-description "The type of pixel format objects. The tuple slot contents should be considered opaque by user code. To check the value of a pixel format's attributes, use the " { $link pixel-format-attribute } " word. Pixel format objects must be freed using the " { $link dispose } " word when they are no longer needed." } ; + +HELP: +{ $values { "world" world } { "attributes" sequence } { "pixel-format" pixel-format } } +{ $description "Requests a pixel format suitable for " { $snippet "world" } " with a set of " { $link "ui.pixel-formats-attributes" } ". If no pixel format can be found that satisfies the given attributes, an " { $link invalid-pixel-format-attributes } " error is thrown. Pixel format attributes not supported by the window system are ignored. The returned " { $snippet "pixel-format" } " must be released using the " { $link dispose } " word when it is no longer needed." } +{ $notes "Pixel formats don't normally need to be directly allocated by user code. If you need to control the pixel format requested by a window, subclass " { $snippet "world" } " and override the " { $link world-pixel-format-attributes } " and " { $link check-world-pixel-format } " words." +$nl +"The returned pixel format does not necessarily exactly match the requested attributes; the window system will try to find the format that best matches the given attributes. Use " { $link pixel-format-attribute } " to check the actual values of the attributes on the returned pixel format." } +; + +HELP: pixel-format-attribute +{ $values { "pixel-format" pixel-format } { "attribute-name" "one of the " { $link "ui.pixel-formats-attributes" } } { "value" object } } +{ $description "Returns the value of the requested " { $snippet "attribute-name" } " in " { $snippet "pixel-format" } ". If " { "attribute-name" } " is unsupported by the window system, " { $link f } " is returned." } ; + +HELP: invalid-pixel-format-attributes +{ $values { "world" world } { "attributes" sequence } } +{ $class-description "Thrown by " { $link } " when the window system is unable to find a pixel format for " { $snippet "world" } " that satisfies the requested " { $snippet "attributes" } "." } ; + +{ world-pixel-format-attributes check-world-pixel-format pixel-format pixel-format-attribute } +related-words + +ARTICLE: "ui.pixel-formats" "Pixel formats" +"The UI allows you to control the window system's OpenGL interface with a cross-platform set of pixel format specifiers:" +{ $subsection "ui.pixel-formats-attributes" } + +"Pixel formats can be requested using these attributes:" +{ $subsection pixel-format } +{ $subsection } +{ $subsection pixel-format-attribute } + +"If a request for a set of pixel format attributes cannot be satisfied, an error is thrown:" +{ $subsection invalid-pixel-format-attributes } + +"Pixel formats are requested as part of opening a window for a " { $link world } ". These generics can be overridden on " { $snippet "world" } " subclasses to control pixel format selection:" +{ $subsection world-pixel-format-attributes } +{ $subsection check-world-pixel-format } +; + +ABOUT: "ui.pixel-formats" diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor new file mode 100644 index 0000000000..52abf44362 --- /dev/null +++ b/basis/ui/pixel-formats/pixel-formats.factor @@ -0,0 +1,94 @@ +USING: accessors assocs classes destructors functors kernel +lexer math parser sequences specialized-arrays.int ui.backend +words.symbol ; +IN: ui.pixel-formats + +SYMBOLS: + double-buffered + stereo + offscreen + fullscreen + windowed + accelerated + software-rendered + backing-store + multisampled + supersampled + sample-alpha + color-float ; + +TUPLE: pixel-format-attribute { value integer } ; + +TUPLE: color-bits < pixel-format-attribute ; +TUPLE: red-bits < pixel-format-attribute ; +TUPLE: green-bits < pixel-format-attribute ; +TUPLE: blue-bits < pixel-format-attribute ; +TUPLE: alpha-bits < pixel-format-attribute ; + +TUPLE: accum-bits < pixel-format-attribute ; +TUPLE: accum-red-bits < pixel-format-attribute ; +TUPLE: accum-green-bits < pixel-format-attribute ; +TUPLE: accum-blue-bits < pixel-format-attribute ; +TUPLE: accum-alpha-bits < pixel-format-attribute ; + +TUPLE: depth-bits < pixel-format-attribute ; + +TUPLE: stencil-bits < pixel-format-attribute ; + +TUPLE: aux-buffers < pixel-format-attribute ; + +TUPLE: sample-buffers < pixel-format-attribute ; +TUPLE: samples < pixel-format-attribute ; + +HOOK: (make-pixel-format) ui-backend ( world attributes -- pixel-format-handle ) +HOOK: (free-pixel-format) ui-backend ( pixel-format -- ) +HOOK: (pixel-format-attribute) ui-backend ( pixel-format attribute-name -- value ) + +ERROR: invalid-pixel-format-attributes world attributes ; + +TUPLE: pixel-format world handle ; + +: ( world attributes -- pixel-format ) + 2dup (make-pixel-format) + [ nip pixel-format boa ] [ invalid-pixel-format-attributes ] if* ; + +M: pixel-format dispose + [ (free-pixel-format) ] [ f >>handle drop ] bi ; + +: pixel-format-attribute ( pixel-format attribute-name -- value ) + (pixel-format-attribute) ; + +PFA DEFINES >${NAME} +>PFA-int-array DEFINES >${NAME}-int-array + +WHERE + +GENERIC: >PFA ( attribute -- pfas ) + +M: object >PFA + drop { } ; +M: symbol >PFA + TABLE at [ { } ] unless* ; +M: pixel-format-attribute >PFA + dup class TABLE at + [ swap value>> suffix ] + [ drop { } ] if* ; + +: >PFA-int-array ( attribute -- int-array ) + [ >PFA ] map concat PERM prepend 0 suffix >int-array ; + +;FUNCTOR + +SYNTAX: PIXEL-FORMAT-ATTRIBUTE-TABLE: + scan scan-object scan-object define-pixel-format-attribute-table ; + +PRIVATE> + +GENERIC: world-pixel-format-attributes ( world -- attributes ) + +GENERIC# check-world-pixel-format 1 ( world pixel-format -- ) + diff --git a/basis/ui/pixel-formats/summary.txt b/basis/ui/pixel-formats/summary.txt new file mode 100644 index 0000000000..517f42458b --- /dev/null +++ b/basis/ui/pixel-formats/summary.txt @@ -0,0 +1 @@ +Cross-platform OpenGL context pixel format specifiers diff --git a/basis/ui/text/text.factor b/basis/ui/text/text.factor index 2edb20fc22..c1f05182e6 100755 --- a/basis/ui/text/text.factor +++ b/basis/ui/text/text.factor @@ -75,10 +75,8 @@ M: array draw-text USING: vocabs.loader namespaces system combinators ; -"ui-backend" get [ - { - { [ os macosx? ] [ "core-text" ] } - { [ os windows? ] [ "uniscribe" ] } - { [ os unix? ] [ "pango" ] } - } cond -] unless* "ui.text." prepend require \ No newline at end of file +{ + { [ os macosx? ] [ "core-text" ] } + { [ os windows? ] [ "uniscribe" ] } + { [ os unix? ] [ "pango" ] } +} cond "ui.text." prepend require diff --git a/basis/windows/gdi32/gdi32.factor b/basis/windows/gdi32/gdi32.factor index 9b7cd2e35e..0699c92be3 100755 --- a/basis/windows/gdi32/gdi32.factor +++ b/basis/windows/gdi32/gdi32.factor @@ -1419,7 +1419,7 @@ DESTRUCTOR: DeleteDC ! FUNCTION: DeleteMetaFile FUNCTION: BOOL DeleteObject ( HGDIOBJ hObject ) ; DESTRUCTOR: DeleteObject -! FUNCTION: DescribePixelFormat +FUNCTION: int DescribePixelFormat ( HDC hdc, int iPixelFormat, UINT nBytes, PIXELFORMATDESCRIPTOR* ppfd ) ; ! FUNCTION: DeviceCapabilitiesExA ! FUNCTION: DeviceCapabilitiesExW ! FUNCTION: DPtoLP diff --git a/basis/windows/opengl32/opengl32.factor b/basis/windows/opengl32/opengl32.factor index d0b396eba2..4173332dc3 100755 --- a/basis/windows/opengl32/opengl32.factor +++ b/basis/windows/opengl32/opengl32.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2005, 2006 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.syntax parser namespaces kernel -math math.bitwise windows.types windows.types init assocs -sequences libc ; +math math.bitwise windows.types init assocs splitting +sequences libc opengl.gl opengl.gl.extensions opengl.gl.windows ; IN: windows.opengl32 ! PIXELFORMATDESCRIPTOR flags @@ -71,22 +71,6 @@ CONSTANT: WGL_SWAP_UNDERLAY13 HEX: 10000000 CONSTANT: WGL_SWAP_UNDERLAY14 HEX: 20000000 CONSTANT: WGL_SWAP_UNDERLAY15 HEX: 40000000 -: windowed-pfd-dwFlags ( -- n ) - { PFD_DRAW_TO_WINDOW PFD_SUPPORT_OPENGL PFD_DOUBLEBUFFER } flags ; -: offscreen-pfd-dwFlags ( -- n ) - { PFD_DRAW_TO_BITMAP PFD_SUPPORT_OPENGL } flags ; - -! TODO: compare to http://www.nullterminator.net/opengl32.html -: make-pfd ( flags bits -- pfd ) - "PIXELFORMATDESCRIPTOR" - "PIXELFORMATDESCRIPTOR" heap-size over set-PIXELFORMATDESCRIPTOR-nSize - 1 over set-PIXELFORMATDESCRIPTOR-nVersion - rot over set-PIXELFORMATDESCRIPTOR-dwFlags - PFD_TYPE_RGBA over set-PIXELFORMATDESCRIPTOR-iPixelType - [ set-PIXELFORMATDESCRIPTOR-cColorBits ] keep - 16 over set-PIXELFORMATDESCRIPTOR-cDepthBits - PFD_MAIN_PLANE over set-PIXELFORMATDESCRIPTOR-dwLayerMask ; - LIBRARY: gl @@ -100,5 +84,112 @@ LIBRARY: gl FUNCTION: HGLRC wglCreateContext ( HDC hDC ) ; FUNCTION: BOOL wglDeleteContext ( HGLRC hRC ) ; FUNCTION: BOOL wglMakeCurrent ( HDC hDC, HGLRC hglrc ) ; -FUNCTION: HGLRC wglGetCurrentContext ( ) ; -FUNCTION: void* wglGetProcAddress ( char* name ) ; + +! WGL_ARB_extensions_string extension + +GL-FUNCTION: char* wglGetExtensionsStringARB { } ( HDC hDC ) ; + +! WGL_ARB_pixel_format extension + +CONSTANT: WGL_NUMBER_PIXEL_FORMATS_ARB HEX: 2000 +CONSTANT: WGL_DRAW_TO_WINDOW_ARB HEX: 2001 +CONSTANT: WGL_DRAW_TO_BITMAP_ARB HEX: 2002 +CONSTANT: WGL_ACCELERATION_ARB HEX: 2003 +CONSTANT: WGL_NEED_PALETTE_ARB HEX: 2004 +CONSTANT: WGL_NEED_SYSTEM_PALETTE_ARB HEX: 2005 +CONSTANT: WGL_SWAP_LAYER_BUFFERS_ARB HEX: 2006 +CONSTANT: WGL_SWAP_METHOD_ARB HEX: 2007 +CONSTANT: WGL_NUMBER_OVERLAYS_ARB HEX: 2008 +CONSTANT: WGL_NUMBER_UNDERLAYS_ARB HEX: 2009 +CONSTANT: WGL_TRANSPARENT_ARB HEX: 200A +CONSTANT: WGL_TRANSPARENT_RED_VALUE_ARB HEX: 2037 +CONSTANT: WGL_TRANSPARENT_GREEN_VALUE_ARB HEX: 2038 +CONSTANT: WGL_TRANSPARENT_BLUE_VALUE_ARB HEX: 2039 +CONSTANT: WGL_TRANSPARENT_ALPHA_VALUE_ARB HEX: 203A +CONSTANT: WGL_TRANSPARENT_INDEX_VALUE_ARB HEX: 203B +CONSTANT: WGL_SHARE_DEPTH_ARB HEX: 200C +CONSTANT: WGL_SHARE_STENCIL_ARB HEX: 200D +CONSTANT: WGL_SHARE_ACCUM_ARB HEX: 200E +CONSTANT: WGL_SUPPORT_GDI_ARB HEX: 200F +CONSTANT: WGL_SUPPORT_OPENGL_ARB HEX: 2010 +CONSTANT: WGL_DOUBLE_BUFFER_ARB HEX: 2011 +CONSTANT: WGL_STEREO_ARB HEX: 2012 +CONSTANT: WGL_PIXEL_TYPE_ARB HEX: 2013 +CONSTANT: WGL_COLOR_BITS_ARB HEX: 2014 +CONSTANT: WGL_RED_BITS_ARB HEX: 2015 +CONSTANT: WGL_RED_SHIFT_ARB HEX: 2016 +CONSTANT: WGL_GREEN_BITS_ARB HEX: 2017 +CONSTANT: WGL_GREEN_SHIFT_ARB HEX: 2018 +CONSTANT: WGL_BLUE_BITS_ARB HEX: 2019 +CONSTANT: WGL_BLUE_SHIFT_ARB HEX: 201A +CONSTANT: WGL_ALPHA_BITS_ARB HEX: 201B +CONSTANT: WGL_ALPHA_SHIFT_ARB HEX: 201C +CONSTANT: WGL_ACCUM_BITS_ARB HEX: 201D +CONSTANT: WGL_ACCUM_RED_BITS_ARB HEX: 201E +CONSTANT: WGL_ACCUM_GREEN_BITS_ARB HEX: 201F +CONSTANT: WGL_ACCUM_BLUE_BITS_ARB HEX: 2020 +CONSTANT: WGL_ACCUM_ALPHA_BITS_ARB HEX: 2021 +CONSTANT: WGL_DEPTH_BITS_ARB HEX: 2022 +CONSTANT: WGL_STENCIL_BITS_ARB HEX: 2023 +CONSTANT: WGL_AUX_BUFFERS_ARB HEX: 2024 + +CONSTANT: WGL_NO_ACCELERATION_ARB HEX: 2025 +CONSTANT: WGL_GENERIC_ACCELERATION_ARB HEX: 2026 +CONSTANT: WGL_FULL_ACCELERATION_ARB HEX: 2027 + +CONSTANT: WGL_SWAP_EXCHANGE_ARB HEX: 2028 +CONSTANT: WGL_SWAP_COPY_ARB HEX: 2029 +CONSTANT: WGL_SWAP_UNDEFINED_ARB HEX: 202A + +CONSTANT: WGL_TYPE_RGBA_ARB HEX: 202B +CONSTANT: WGL_TYPE_COLORINDEX_ARB HEX: 202C + +GL-FUNCTION: BOOL wglGetPixelFormatAttribivARB { } ( + HDC hdc, + int iPixelFormat, + int iLayerPlane, + UINT nAttributes, + int* piAttributes, + int* piValues + ) ; + +GL-FUNCTION: BOOL wglGetPixelFormatAttribfvARB { } ( + HDC hdc, + int iPixelFormat, + int iLayerPlane, + UINT nAttributes, + int* piAttributes, + FLOAT* pfValues + ) ; + +GL-FUNCTION: BOOL wglChoosePixelFormatARB { } ( + HDC hdc, + int* piAttribIList, + FLOAT* pfAttribFList, + UINT nMaxFormats, + int* piFormats, + UINT* nNumFormats + ) ; + +! WGL_ARB_multisample extension + +CONSTANT: WGL_SAMPLE_BUFFERS_ARB HEX: 2041 +CONSTANT: WGL_SAMPLES_ARB HEX: 2042 + +! WGL_ARB_pixel_format_float extension + +CONSTANT: WGL_TYPE_RGBA_FLOAT_ARB HEX: 21A0 + +! wgl extensions querying + +: has-wglGetExtensionsStringARB? ( -- ? ) + "wglGetExtensionsStringARB" wglGetProcAddress >boolean ; + +: wgl-extensions ( hdc -- extensions ) + has-wglGetExtensionsStringARB? [ wglGetExtensionsStringARB " " split ] [ drop { } ] if ; + +: has-wgl-extensions? ( hdc extensions -- ? ) + swap wgl-extensions [ member? ] curry all? ; + +: has-wgl-pixel-format-extension? ( hdc -- ? ) + { "WGL_ARB_pixel_format" } has-wgl-extensions? ; diff --git a/basis/x11/glx/glx.factor b/basis/x11/glx/glx.factor index dc6157b87f..67ac0e8cc1 100644 --- a/basis/x11/glx/glx.factor +++ b/basis/x11/glx/glx.factor @@ -84,20 +84,17 @@ X-FUNCTION: void* glXGetProcAddress ( char* procname ) ; ! GLX_ARB_get_proc_address extension X-FUNCTION: void* glXGetProcAddressARB ( char* procname ) ; +! GLX_ARB_multisample +CONSTANT: GLX_SAMPLE_BUFFERS 100000 +CONSTANT: GLX_SAMPLES 100001 + +! GLX_ARB_fbconfig_float +CONSTANT: GLX_RGBA_FLOAT_TYPE HEX: 20B9 +CONSTANT: GLX_RGBA_FLOAT_BIT HEX: 0004 + ! GLX Events ! (also skipped for now. only has GLXPbufferClobberEvent, the rest is handled by xlib methinks) -: choose-visual ( flags -- XVisualInfo* ) - [ dpy get scr get ] dip - [ - % - GLX_RGBA , - GLX_DEPTH_SIZE , 16 , - 0 , - ] int-array{ } make - glXChooseVisual - [ "Could not get a double-buffered GLX RGBA visual" throw ] unless* ; - : create-glx ( XVisualInfo* -- GLXContext ) [ dpy get ] dip f 1 glXCreateContext [ "Failed to create GLX context" throw ] unless* ; diff --git a/basis/x11/windows/windows.factor b/basis/x11/windows/windows.factor index 37da51e9b8..54cf205c14 100644 --- a/basis/x11/windows/windows.factor +++ b/basis/x11/windows/windows.factor @@ -53,11 +53,8 @@ IN: x11.windows dup ] dip auto-position ; -: glx-window ( loc dim -- window glx ) - GLX_DOUBLEBUFFER 1array choose-visual - [ create-window ] keep - [ create-glx ] keep - XFree ; +: glx-window ( loc dim visual -- window glx ) + [ create-window ] [ create-glx ] bi ; : create-pixmap ( dim visual -- pixmap ) [ [ { 0 0 } swap ] dip create-window ] [ @@ -74,9 +71,8 @@ IN: x11.windows : create-glx-pixmap ( dim visual -- pixmap glx-pixmap ) [ create-pixmap ] [ (create-glx-pixmap) ] bi ; -: glx-pixmap ( dim -- glx pixmap glx-pixmap ) - { } choose-visual - [ nip create-glx ] [ create-glx-pixmap ] [ nip XFree ] 2tri ; +: glx-pixmap ( dim visual -- glx pixmap glx-pixmap ) + [ nip create-glx ] [ create-glx-pixmap ] 2bi ; : destroy-window ( win -- ) dpy get swap XDestroyWindow drop ; diff --git a/extra/ui/offscreen/offscreen.factor b/extra/ui/offscreen/offscreen.factor index 8d197eb844..c6669eb16f 100755 --- a/extra/ui/offscreen/offscreen.factor +++ b/extra/ui/offscreen/offscreen.factor @@ -6,6 +6,9 @@ IN: ui.offscreen TUPLE: offscreen-world < world ; +M: offscreen-world world-pixel-format-attributes + { offscreen T{ depth-bits { value 16 } } } ; + : ( gadget title status -- world ) offscreen-world new-world ;