Merge branch 'master' of git://factorcode.org/git/factor
John Benediktsson
commit
a646d5c101
|
|
@ -1,13 +1,9 @@
|
|||
USING: help.syntax help.markup ;
|
||||
USING: help.syntax help.markup ui.pixel-formats ;
|
||||
IN: cocoa.views
|
||||
|
||||
HELP: <PixelFormat>
|
||||
{ $values { "attributes" "a sequence of attributes" } { "pixelfmt" "an " { $snippet "NSOpenGLPixelFormat" } } }
|
||||
{ $description "Creates an " { $snippet "NSOpenGLPixelFormat" } " with some reasonable defaults." } ;
|
||||
|
||||
HELP: <GLView>
|
||||
{ $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 <PixelFormat> }
|
||||
{ $subsection <GLView> }
|
||||
{ $subsection view-dim }
|
||||
{ $subsection mouse-location } ;
|
||||
|
|
|
|||
|
|
@ -42,39 +42,10 @@ CONSTANT: NSOpenGLPFAAllowOfflineRenderers 96
|
|||
CONSTANT: NSOpenGLPFAVirtualScreenCount 128
|
||||
CONSTANT: NSOpenGLCPSwapInterval 222
|
||||
|
||||
<PRIVATE
|
||||
|
||||
SYMBOL: software-renderer?
|
||||
SYMBOL: multisample?
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: with-software-renderer ( quot -- )
|
||||
[ t software-renderer? ] dip with-variable ; inline
|
||||
|
||||
: with-multisample ( quot -- )
|
||||
[ t multisample? ] dip with-variable ; inline
|
||||
|
||||
: <PixelFormat> ( 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 ;
|
||||
|
||||
: <GLView> ( class dim -- view )
|
||||
[ -> alloc 0 0 ] dip first2 <CGRect>
|
||||
NSOpenGLPFAWindow NSOpenGLPFADoubleBuffer 2array <PixelFormat>
|
||||
: <GLView> ( class dim pixel-format -- view )
|
||||
[ -> alloc ]
|
||||
[ [ 0 0 ] dip first2 <CGRect> ]
|
||||
[ handle>> ] tri*
|
||||
-> initWithFrame:pixelFormat:
|
||||
dup 1 -> setPostsBoundsChangedNotifications:
|
||||
dup 1 -> setPostsFrameChangedNotifications: ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
"> <string-reader> "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
|
||||
|
||||
|
|
|
|||
|
|
@ -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: }
|
||||
|
|
|
|||
|
|
@ -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
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -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 } } ;
|
||||
|
||||
: <rect> ( loc dim -- rect ) rect boa ; inline
|
||||
|
||||
SYNTAX: RECT: scan-object scan-object <rect> parsed ;
|
||||
|
||||
M: rect pprint*
|
||||
\ RECT: [ [ loc>> ] [ dim>> ] bi [ pprint* ] bi@ ] pprint-prefix ;
|
||||
|
||||
: <zero-rect> ( -- rect ) rect new ; inline
|
||||
|
||||
: point>rect ( loc -- rect ) { 0 0 } <rect> ; inline
|
||||
|
|
@ -55,4 +61,4 @@ M: rect contains-point?
|
|||
: set-rect-bounds ( rect1 rect -- )
|
||||
[ [ loc>> ] dip (>>loc) ]
|
||||
[ [ dim>> ] dip (>>dim) ]
|
||||
2bi ; inline
|
||||
2bi ; inline
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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> 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 <int> [ swap 0 -> getValues:forAttribute:forVirtualScreen: ] keep *int ]
|
||||
if-empty ;
|
||||
|
||||
TUPLE: pasteboard handle ;
|
||||
|
||||
C: <pasteboard> 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>> <FactorView> :> view
|
||||
world [ [ dim>> ] dip <FactorView> ]
|
||||
with-world-pixel-format :> view
|
||||
view world world>NSRect <ViewWindow> :> 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 <int> [ 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 <PixelFormat>
|
||||
[ 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 <offscreen-handle> >>handle drop ;
|
||||
|
|
|
|||
|
|
@ -365,8 +365,8 @@ CLASS: {
|
|||
-> openGLContext -> CGLContextObj NSOpenGLCPSwapInterval 1 <int>
|
||||
CGLSetParameter drop ;
|
||||
|
||||
: <FactorView> ( dim -- view )
|
||||
FactorView swap <GLView> [ sync-refresh-to-screen ] keep ;
|
||||
: <FactorView> ( dim pixel-format -- view )
|
||||
[ FactorView ] 2dip <GLView> [ sync-refresh-to-screen ] keep ;
|
||||
|
||||
: save-position ( world window -- )
|
||||
-> frame CGRect-top-left 2array >>window-loc drop ;
|
||||
|
|
|
|||
|
|
@ -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> win
|
||||
C: <win-offscreen> win-offscreen
|
||||
|
||||
<PRIVATE
|
||||
|
||||
PIXEL-FORMAT-ATTRIBUTE-TABLE: WGL_ARB { $ WGL_SUPPORT_OPENGL_ARB 1 } H{
|
||||
{ double-buffered { $ WGL_DOUBLE_BUFFER_ARB 1 } }
|
||||
{ stereo { $ WGL_STEREO_ARB 1 } }
|
||||
{ offscreen { $ WGL_DRAW_TO_BITMAP_ARB 1 } }
|
||||
{ fullscreen { $ WGL_DRAW_TO_WINDOW_ARB 1 } }
|
||||
{ windowed { $ WGL_DRAW_TO_WINDOW_ARB 1 } }
|
||||
{ accelerated { $ WGL_ACCELERATION_ARB $ WGL_FULL_ACCELERATION_ARB } }
|
||||
{ software-rendered { $ WGL_ACCELERATION_ARB $ WGL_NO_ACCELERATION_ARB } }
|
||||
{ backing-store { $ WGL_SWAP_METHOD_ARB $ WGL_SWAP_COPY_ARB } }
|
||||
{ color-float { $ WGL_TYPE_RGBA_FLOAT_ARB 1 } }
|
||||
{ color-bits { $ WGL_COLOR_BITS_ARB } }
|
||||
{ red-bits { $ WGL_RED_BITS_ARB } }
|
||||
{ green-bits { $ WGL_GREEN_BITS_ARB } }
|
||||
{ blue-bits { $ WGL_BLUE_BITS_ARB } }
|
||||
{ alpha-bits { $ WGL_ALPHA_BITS_ARB } }
|
||||
{ accum-bits { $ WGL_ACCUM_BITS_ARB } }
|
||||
{ accum-red-bits { $ WGL_ACCUM_RED_BITS_ARB } }
|
||||
{ accum-green-bits { $ WGL_ACCUM_GREEN_BITS_ARB } }
|
||||
{ accum-blue-bits { $ WGL_ACCUM_BLUE_BITS_ARB } }
|
||||
{ accum-alpha-bits { $ WGL_ACCUM_ALPHA_BITS_ARB } }
|
||||
{ depth-bits { $ WGL_DEPTH_BITS_ARB } }
|
||||
{ stencil-bits { $ WGL_STENCIL_BITS_ARB } }
|
||||
{ aux-buffers { $ WGL_AUX_BUFFERS_ARB } }
|
||||
{ sample-buffers { $ WGL_SAMPLE_BUFFERS_ARB } }
|
||||
{ samples { $ WGL_SAMPLES_ARB } }
|
||||
}
|
||||
|
||||
MEMO: (has-wglChoosePixelFormatARB?) ( dc -- ? )
|
||||
{ "WGL_ARB_pixel_format" } has-wgl-extensions? ;
|
||||
: has-wglChoosePixelFormatARB? ( world -- ? )
|
||||
handle>> hDC>> (has-wglChoosePixelFormatARB?) ;
|
||||
|
||||
: arb-make-pixel-format ( world attributes -- pf )
|
||||
[ handle>> hDC>> ] dip >WGL_ARB-int-array f 1 0 <int> 0 <int>
|
||||
[ 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 <int> 0 <int>
|
||||
[ 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" <c-object>
|
||||
"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" <c-object>
|
||||
[ 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> *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 ;
|
|||
<pasteboard> clipboard set-global
|
||||
<clipboard> selection set-global ;
|
||||
|
||||
TUPLE: win-base hDC hRC ;
|
||||
TUPLE: win < win-base hWnd world title ;
|
||||
TUPLE: win-offscreen < win-base hBitmap bits ;
|
||||
C: <win> win
|
||||
C: <win-offscreen> 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" <c-object> 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 <win> ] keep
|
||||
[ swap hWnd>> register-window ] 2keep
|
||||
dupd (>>handle)
|
||||
hWnd>> show-window ;
|
||||
[ dup create-window [ f f ] dip f f <win> >>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 <win-offscreen>
|
||||
>>handle drop ;
|
||||
win-offscreen new >>handle
|
||||
setup-offscreen-gl ;
|
||||
|
||||
M: windows-ui-backend (close-offscreen-buffer) ( handle -- )
|
||||
[ hDC>> DeleteDC drop ]
|
||||
|
|
|
|||
|
|
@ -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 <int> [ 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
|
||||
<x11-handle>
|
||||
[ 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 <x11-pixmap-handle> >>handle drop ;
|
||||
dup [ [ dim>> ] [ handle>> ] bi* glx-pixmap ]
|
||||
with-world-pixel-format
|
||||
<x11-pixmap-handle> >>handle drop ;
|
||||
M: x11-ui-backend (close-offscreen-buffer) ( handle -- )
|
||||
dpy get swap
|
||||
[ glx-pixmap>> glXDestroyGLXPixmap ]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 <pixel-format> ]
|
||||
dip [ 2dup check-world-pixel-format ] prepose with-disposal ; inline
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Joe Groff
|
||||
|
|
@ -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: <pixel-format>
|
||||
{ $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 <pixel-format> } " 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> 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 <pixel-format> }
|
||||
{ $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"
|
||||
|
|
@ -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 ;
|
||||
|
||||
: <pixel-format> ( 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) ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
FUNCTOR: define-pixel-format-attribute-table ( NAME PERM TABLE -- )
|
||||
|
||||
>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 -- )
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
Cross-platform OpenGL context pixel format specifiers
|
||||
|
|
@ -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
|
||||
{
|
||||
{ [ os macosx? ] [ "core-text" ] }
|
||||
{ [ os windows? ] [ "uniscribe" ] }
|
||||
{ [ os unix? ] [ "pango" ] }
|
||||
} cond "ui.text." prepend require
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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" <c-object>
|
||||
"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? ;
|
||||
|
|
|
|||
|
|
@ -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* ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -6,6 +6,9 @@ IN: ui.offscreen
|
|||
|
||||
TUPLE: offscreen-world < world ;
|
||||
|
||||
M: offscreen-world world-pixel-format-attributes
|
||||
{ offscreen T{ depth-bits { value 16 } } } ;
|
||||
|
||||
: <offscreen-world> ( gadget title status -- world )
|
||||
offscreen-world new-world ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue