From c3b63821b9dad9e025a081496045215bda92c622 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 29 Apr 2009 14:58:55 -0500
Subject: [PATCH 01/27] literal syntax for rects
---
basis/math/rectangles/rectangles-tests.factor | 28 +++++++++----------
basis/math/rectangles/rectangles.factor | 10 +++++--
2 files changed, 22 insertions(+), 16 deletions(-)
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 } } ;
: <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
\ No newline at end of file
+ 2bi ; inline
From 7857c0c939bcb16d82506a09de0f9db737ea201c Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 29 Apr 2009 14:59:54 -0500
Subject: [PATCH 02/27] typo in delegate docs
---
basis/delegate/delegate-docs.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
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
From 76d375b56b7003aa8197e7740191214d7f3c7b7f Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 30 Apr 2009 20:31:33 -0500
Subject: [PATCH 03/27] OS-independent pixel formats abstraction
---
basis/ui/pixel-formats/pixel-formats.factor | 58 +++++++++++++++++++++
1 file changed, 58 insertions(+)
create mode 100644 basis/ui/pixel-formats/pixel-formats.factor
diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor
new file mode 100644
index 0000000000..09450f2c72
--- /dev/null
+++ b/basis/ui/pixel-formats/pixel-formats.factor
@@ -0,0 +1,58 @@
+USING: destructors math ui.backend ;
+IN: ui.pixel-formats
+
+SINGLETONS:
+ double-buffered
+ stereo
+ offscreen
+ fullscreen
+ windowed
+ accelerated
+ software-rendered
+ robust
+ 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: buffer-level < pixel-format-attribute ;
+
+TUPLE: sample-buffers < pixel-format-attribute ;
+TUPLE: samples < pixel-format-attribute ;
+
+HOOK: (make-pixel-format) ui-backend ( attributes -- pixel-format-handle )
+HOOK: (free-pixel-format) ui-backend ( pixel-format-handle -- )
+HOOK: (pixel-format-attribute) ui-backend ( pixel-format-handle attribute-name -- value )
+
+TUPLE: pixel-format { handle read-only } ;
+
+: <pixel-format> ( attributes -- pixel-format )
+ (make-pixel-format) pixel-format boa ;
+
+M: pixel-format dispose
+ [ [ (free-pixel-format) ] when* f ] change-handle drop ;
+
+: pixel-format-attribute ( pixel-format attribute-name -- value )
+ [ handle>> ] dip (pixel-format-attribute) ;
+
From 3edd57aaa4e37ddc917a3301d03e106e05ac168a Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 30 Apr 2009 20:38:18 -0500
Subject: [PATCH 04/27] eliminate windows.opengl32 dependency from
opengl.gl.windows so we can use opengl.gl.extensions to define wgl extensions
---
basis/opengl/gl/windows/windows.factor | 7 ++++++-
basis/windows/opengl32/opengl32.factor | 5 +++--
2 files changed, 9 insertions(+), 3 deletions(-)
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/windows/opengl32/opengl32.factor b/basis/windows/opengl32/opengl32.factor
index d0b396eba2..f63a4a956a 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
+sequences libc opengl.gl ;
IN: windows.opengl32
! PIXELFORMATDESCRIPTOR flags
@@ -100,5 +100,6 @@ 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 ) ;
From 9149f375d1b14c84f99f92b3d4d8f7fd5329dd9b Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 30 Apr 2009 21:35:50 -0500
Subject: [PATCH 05/27] WGL_ARB_pixel_format extension binding
---
basis/windows/opengl32/opengl32.factor | 112 ++++++++++++++++++++++++-
1 file changed, 109 insertions(+), 3 deletions(-)
diff --git a/basis/windows/opengl32/opengl32.factor b/basis/windows/opengl32/opengl32.factor
index f63a4a956a..d5e8fe9a66 100755
--- a/basis/windows/opengl32/opengl32.factor
+++ b/basis/windows/opengl32/opengl32.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax parser namespaces kernel
math math.bitwise windows.types init assocs
-sequences libc opengl.gl ;
+sequences libc opengl.gl opengl.gl.extensions opengl.gl.windows ;
IN: windows.opengl32
! PIXELFORMATDESCRIPTOR flags
@@ -101,5 +101,111 @@ 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? ;
From 8a4c6a30f90886f4b6a02401369361cd122791b4 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 30 Apr 2009 22:28:45 -0500
Subject: [PATCH 06/27] multisample and float extensions for GLX
---
basis/x11/glx/glx.factor | 8 ++++++++
1 file changed, 8 insertions(+)
diff --git a/basis/x11/glx/glx.factor b/basis/x11/glx/glx.factor
index dc6157b87f..b459b55f46 100644
--- a/basis/x11/glx/glx.factor
+++ b/basis/x11/glx/glx.factor
@@ -84,6 +84,14 @@ 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)
From b6074b95fafe484484ffff8e42587c7b2f1e72b2 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 30 Apr 2009 22:35:15 -0500
Subject: [PATCH 07/27] get rid of variable-based pixel format crap in
cocoa.views
---
basis/cocoa/views/views.factor | 25 ++++---------------------
1 file changed, 4 insertions(+), 21 deletions(-)
diff --git a/basis/cocoa/views/views.factor b/basis/cocoa/views/views.factor
index 3c60a6a7c1..69d0f98618 100644
--- a/basis/cocoa/views/views.factor
+++ b/basis/cocoa/views/views.factor
@@ -42,31 +42,14 @@ 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
+ ! NSOpenGLPFARendererID , kCGLRendererGenericFloatID ,
+ ! NSOpenGLPFASupersample ,
+ ! NSOpenGLPFASampleBuffers , 1 ,
+ ! NSOpenGLPFASamples , 8 ,
0 ,
] int-array{ } make
-> initWithAttributes:
From 87daa532a6f36ca1ff225bc5aac3f32f8e4cf39a Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Thu, 30 Apr 2009 22:48:01 -0500
Subject: [PATCH 08/27] move literals vocab to basis
---
{extra => basis}/literals/authors.txt | 0
{extra => basis}/literals/literals-docs.factor | 0
{extra => basis}/literals/literals-tests.factor | 0
{extra => basis}/literals/literals.factor | 0
{extra => basis}/literals/summary.txt | 0
{extra => basis}/literals/tags.txt | 0
6 files changed, 0 insertions(+), 0 deletions(-)
rename {extra => basis}/literals/authors.txt (100%)
rename {extra => basis}/literals/literals-docs.factor (100%)
rename {extra => basis}/literals/literals-tests.factor (100%)
rename {extra => basis}/literals/literals.factor (100%)
rename {extra => basis}/literals/summary.txt (100%)
rename {extra => basis}/literals/tags.txt (100%)
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
From ba8abd6cad39035ebff3f708af07823b54b7cb30 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 1 May 2009 09:09:38 -0500
Subject: [PATCH 09/27] cocoa backend support for ui.pixel-formats;
world-pixel-format-attributes generic
---
basis/cocoa/views/views.factor | 20 ++----
basis/ui/backend/cocoa/cocoa.factor | 73 ++++++++++++++++++---
basis/ui/backend/cocoa/views/views.factor | 4 +-
basis/ui/gadgets/worlds/worlds.factor | 11 +++-
basis/ui/pixel-formats/pixel-formats.factor | 2 +-
5 files changed, 80 insertions(+), 30 deletions(-)
diff --git a/basis/cocoa/views/views.factor b/basis/cocoa/views/views.factor
index 69d0f98618..f65fddac58 100644
--- a/basis/cocoa/views/views.factor
+++ b/basis/cocoa/views/views.factor
@@ -42,22 +42,10 @@ CONSTANT: NSOpenGLPFAAllowOfflineRenderers 96
CONSTANT: NSOpenGLPFAVirtualScreenCount 128
CONSTANT: NSOpenGLCPSwapInterval 222
-: <PixelFormat> ( attributes -- pixelfmt )
- NSOpenGLPixelFormat -> alloc swap [
- %
- NSOpenGLPFADepthSize , 16 ,
- ! NSOpenGLPFARendererID , kCGLRendererGenericFloatID ,
- ! NSOpenGLPFASupersample ,
- ! NSOpenGLPFASampleBuffers , 1 ,
- ! NSOpenGLPFASamples , 8 ,
- 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: ;
diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor
index 362305c8f7..fbc713ac9a 100755
--- a/basis/ui/backend/cocoa/cocoa.factor
+++ b/basis/ui/backend/cocoa/cocoa.factor
@@ -1,14 +1,15 @@
! 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
+command-line kernel memory namespaces cocoa.messages classes
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 ;
+combinators io.thread locals ui.pixel-formats
+specialized-arrays.int literals core-graphics ;
IN: ui.backend.cocoa
TUPLE: handle ;
@@ -20,6 +21,57 @@ C: <offscreen-handle> offscreen-handle
SINGLETON: cocoa-ui-backend
+<PRIVATE
+
+GENERIC: >NSOpenGLPFA ( attribute -- NSOpenGLPFAs )
+
+CONSTANT: attribute>NSOpenGLPFA-map H{
+ { double-buffered { $ NSOpenGLPFADoubleBuffer } }
+ { stereo { $ NSOpenGLPFAStereo } }
+ { offscreen { $ NSOpenGLPFAOffScreen } }
+ { fullscreen { $ NSOpenGLPFAFullScreen } }
+ { windowed { $ NSOpenGLPFAWindow } }
+ { accelerated { $ NSOpenGLPFAAccelerated } }
+ { software-rendered { $ NSOpenGLPFASingleRenderer $ kCGLRendererGenericFloatID } }
+ { robust { $ NSOpenGLPFARobust } }
+ { 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: object >NSOpenGLPFA
+ drop { } ;
+M: symbol >NSOpenGLPFA
+ attribute>NSOpenGLPFA-map at [ { } ] unless* ;
+M: pixel-format-attribute >NSOpenGLPFA
+ dup class attribute>NSOpenGLPFA-map at
+ [ swap value>> suffix ]
+ [ drop { } ] if ;
+
+PRIVATE>
+
+M: cocoa-ui-backend (make-pixel-format)
+ [ >NSOpenGLPFA ] map concat >int-array
+ NSOpenGLPixelFormat -> alloc swap -> initWithAttributes: ;
+
+M: cocoa-ui-backend (free-pixel-format)
+ -> release ;
+
+M: cocoa-ui-backend (pixel-format-attribute)
+ attribute>NSOpenGLPFA-map at
+ [ first 0 <int> [ swap 0 -> getValues:forAttribute:forVirtualScreen: ] keep *int ]
+ [ f ] if* ;
+
TUPLE: pasteboard handle ;
C: <pasteboard> pasteboard
@@ -70,7 +122,7 @@ M: cocoa-ui-backend fullscreen* ( world -- ? )
handle>> view>> -> isInFullScreenMode zero? not ;
M:: cocoa-ui-backend (open-window) ( world -- )
- world dim>> <FactorView> :> view
+ [ [ dim>> ] dip <FactorView> ] with-world-pixel-format :> view
view world world>NSRect <ViewWindow> :> window
view -> release
world view register-window
@@ -97,18 +149,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 world-pixel-format-attributes offscreen suffix
+ <pixel-format> [
+ :> pf
+ NSOpenGLContext -> alloc pf handle>> f -> initWithFormat:shareContext:
+ dup world pf offscreen-buffer -> setOffScreen:width:height:rowbytes:
+ ] with-disposal ;
M: cocoa-ui-backend (open-offscreen-buffer) ( world -- )
dup gadget-offscreen-context <offscreen-handle> >>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 <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 ;
diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor
index a186de7670..d4162fa630 100644
--- 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,12 @@ M: world handle-gesture ( gesture gadget -- ? )
: close-global ( world global -- )
[ get-global find-world eq? ] keep '[ f _ set-global ] when ;
+
+GENERIC: world-pixel-format-attributes ( world -- attributes )
+
+M: world world-pixel-format-attributes
+ { windowed double-buffered T{ depth-bits { value 16 } } } ;
+
+: with-world-pixel-format ( world quot -- )
+ [ dup world-pixel-format-attributes <pixel-format> ]
+ dip with-disposal ; inline
diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor
index 09450f2c72..66de98ea1c 100644
--- a/basis/ui/pixel-formats/pixel-formats.factor
+++ b/basis/ui/pixel-formats/pixel-formats.factor
@@ -1,7 +1,7 @@
USING: destructors math ui.backend ;
IN: ui.pixel-formats
-SINGLETONS:
+SYMBOLS:
double-buffered
stereo
offscreen
From b45ea14d39f83bfd3b446f019cf8f21025a00a07 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 1 May 2009 12:56:52 -0500
Subject: [PATCH 10/27] compilation fixes
---
basis/cocoa/views/views-docs.factor | 11 ++-----
basis/ui/backend/cocoa/cocoa.factor | 32 +++++++++++----------
basis/ui/gadgets/worlds/worlds.factor | 1 +
basis/ui/pixel-formats/pixel-formats.factor | 7 +++--
4 files changed, 26 insertions(+), 25 deletions(-)
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: <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 } ;
diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor
index fbc713ac9a..8a91dfd94d 100755
--- a/basis/ui/backend/cocoa/cocoa.factor
+++ b/basis/ui/backend/cocoa/cocoa.factor
@@ -1,15 +1,15 @@
! 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 classes
-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 ui.pixel-formats
-specialized-arrays.int literals core-graphics ;
+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.private words.symbol ;
IN: ui.backend.cocoa
TUPLE: handle ;
@@ -56,12 +56,12 @@ M: symbol >NSOpenGLPFA
M: pixel-format-attribute >NSOpenGLPFA
dup class attribute>NSOpenGLPFA-map at
[ swap value>> suffix ]
- [ drop { } ] if ;
+ [ drop { } ] if* ;
PRIVATE>
M: cocoa-ui-backend (make-pixel-format)
- [ >NSOpenGLPFA ] map concat >int-array
+ [ >NSOpenGLPFA ] map concat 0 suffix >int-array
NSOpenGLPixelFormat -> alloc swap -> initWithAttributes: ;
M: cocoa-ui-backend (free-pixel-format)
@@ -70,7 +70,7 @@ M: cocoa-ui-backend (free-pixel-format)
M: cocoa-ui-backend (pixel-format-attribute)
attribute>NSOpenGLPFA-map at
[ first 0 <int> [ swap 0 -> getValues:forAttribute:forVirtualScreen: ] keep *int ]
- [ f ] if* ;
+ [ drop f ] if* ;
TUPLE: pasteboard handle ;
@@ -122,7 +122,8 @@ M: cocoa-ui-backend fullscreen* ( world -- ? )
handle>> view>> -> isInFullScreenMode zero? not ;
M:: cocoa-ui-backend (open-window) ( world -- )
- [ [ dim>> ] dip <FactorView> ] with-world-pixel-format :> view
+ world [ [ dim>> ] dip <FactorView> ]
+ with-world-pixel-format :> view
view world world>NSRect <ViewWindow> :> window
view -> release
world view register-window
@@ -160,7 +161,8 @@ M: cocoa-ui-backend raise-window* ( world -- )
<pixel-format> [
:> pf
NSOpenGLContext -> alloc pf handle>> f -> initWithFormat:shareContext:
- dup world pf offscreen-buffer -> setOffScreen:width:height:rowbytes:
+ dup world pf offscreen-buffer
+ 4 npick [ -> setOffScreen:width:height:rowbytes: ] dip
] with-disposal ;
M: cocoa-ui-backend (open-offscreen-buffer) ( world -- )
diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor
index d4162fa630..0328d453d4 100644
--- a/basis/ui/gadgets/worlds/worlds.factor
+++ b/basis/ui/gadgets/worlds/worlds.factor
@@ -153,6 +153,7 @@ M: world handle-gesture ( gesture gadget -- ? )
GENERIC: world-pixel-format-attributes ( world -- attributes )
M: world world-pixel-format-attributes
+ drop
{ windowed double-buffered T{ depth-bits { value 16 } } } ;
: with-world-pixel-format ( world quot -- )
diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor
index 66de98ea1c..3c41926c21 100644
--- a/basis/ui/pixel-formats/pixel-formats.factor
+++ b/basis/ui/pixel-formats/pixel-formats.factor
@@ -1,4 +1,4 @@
-USING: destructors math ui.backend ;
+USING: accessors destructors kernel math ui.backend ;
IN: ui.pixel-formats
SYMBOLS:
@@ -45,10 +45,13 @@ HOOK: (make-pixel-format) ui-backend ( attributes -- pixel-format-handle )
HOOK: (free-pixel-format) ui-backend ( pixel-format-handle -- )
HOOK: (pixel-format-attribute) ui-backend ( pixel-format-handle attribute-name -- value )
+ERROR: invalid-pixel-format-attributes attributes ;
+
TUPLE: pixel-format { handle read-only } ;
: <pixel-format> ( attributes -- pixel-format )
- (make-pixel-format) pixel-format boa ;
+ dup (make-pixel-format)
+ [ nip pixel-format boa ] [ invalid-pixel-format-attributes ] if* ;
M: pixel-format dispose
[ [ (free-pixel-format) ] when* f ] change-handle drop ;
From cf6e78303b2cd222d6654d09be223bc60b88768a Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 1 May 2009 13:21:57 -0500
Subject: [PATCH 11/27] don't really want that read-only!
---
basis/ui/pixel-formats/pixel-formats.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor
index 3c41926c21..3032c2551f 100644
--- a/basis/ui/pixel-formats/pixel-formats.factor
+++ b/basis/ui/pixel-formats/pixel-formats.factor
@@ -47,7 +47,7 @@ HOOK: (pixel-format-attribute) ui-backend ( pixel-format-handle attribute-name -
ERROR: invalid-pixel-format-attributes attributes ;
-TUPLE: pixel-format { handle read-only } ;
+TUPLE: pixel-format handle ;
: <pixel-format> ( attributes -- pixel-format )
dup (make-pixel-format)
From b3c9201da73c5cdf76e845e8ca6588fec782e17a Mon Sep 17 00:00:00 2001
From: "U-FROGGER\\erg" <erg@frogger.(none)>
Date: Fri, 1 May 2009 14:02:26 -0500
Subject: [PATCH 12/27] fix GL-FUNCTION: syntax on wgl extension functions
---
basis/windows/opengl32/opengl32.factor | 10 +++++-----
1 file changed, 5 insertions(+), 5 deletions(-)
diff --git a/basis/windows/opengl32/opengl32.factor b/basis/windows/opengl32/opengl32.factor
index d5e8fe9a66..d54d142b1f 100755
--- a/basis/windows/opengl32/opengl32.factor
+++ b/basis/windows/opengl32/opengl32.factor
@@ -1,7 +1,7 @@
! 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 init assocs
+math math.bitwise windows.types init assocs splitting
sequences libc opengl.gl opengl.gl.extensions opengl.gl.windows ;
IN: windows.opengl32
@@ -103,7 +103,7 @@ FUNCTION: BOOL wglMakeCurrent ( HDC hDC, HGLRC hglrc ) ;
! WGL_ARB_extensions_string extension
-GL-FUNCTION: char* wglGetExtensionsStringARB ( HDC hDC ) ;
+GL-FUNCTION: char* wglGetExtensionsStringARB { } ( HDC hDC ) ;
! WGL_ARB_pixel_format extension
@@ -160,7 +160,7 @@ 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 (
+GL-FUNCTION: BOOL wglGetPixelFormatAttribivARB { } (
HDC hdc,
int iPixelFormat,
int iLayerPlane,
@@ -169,7 +169,7 @@ GL-FUNCTION: BOOL wglGetPixelFormatAttribivARB (
int* piValues
) ;
-GL-FUNCTION: BOOL wglGetPixelFormatAttribfvARB (
+GL-FUNCTION: BOOL wglGetPixelFormatAttribfvARB { } (
HDC hdc,
int iPixelFormat,
int iLayerPlane,
@@ -178,7 +178,7 @@ GL-FUNCTION: BOOL wglGetPixelFormatAttribfvARB (
FLOAT* pfValues
) ;
-GL-FUNCTION: BOOL wglChoosePixelFormatARB (
+GL-FUNCTION: BOOL wglChoosePixelFormatARB { } (
HDC hdc,
int* piAttribIList,
FLOAT* pfAttribFList,
From 65b33c145c4936660461bfeb04249cddb0985f0c Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 1 May 2009 16:16:40 -0500
Subject: [PATCH 13/27] GENERIC: support in functors
---
basis/functors/functors-tests.factor | 26 ++++++++++++++++++++++++--
basis/functors/functors.factor | 20 ++++++++++++++------
2 files changed, 38 insertions(+), 8 deletions(-)
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
"> <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
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: }
From 2a7c26c20a9cf3d53ab607e6deeea4f04e51ef5a Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 1 May 2009 16:33:49 -0500
Subject: [PATCH 14/27] shove cocoa pixel format attribute conversion into a
functor so we can reuse it
---
basis/ui/backend/cocoa/cocoa.factor | 23 +++++---------
basis/ui/pixel-formats/pixel-formats.factor | 33 ++++++++++++++++++++-
2 files changed, 39 insertions(+), 17 deletions(-)
diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor
index 8a91dfd94d..ba0a7b9c7e 100755
--- a/basis/ui/backend/cocoa/cocoa.factor
+++ b/basis/ui/backend/cocoa/cocoa.factor
@@ -9,7 +9,8 @@ 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.private words.symbol ;
+ui.gadgets.worlds ui.pixel-formats ui.pixel-formats.private
+ui.private words.symbol ;
IN: ui.backend.cocoa
TUPLE: handle ;
@@ -23,9 +24,7 @@ SINGLETON: cocoa-ui-backend
<PRIVATE
-GENERIC: >NSOpenGLPFA ( attribute -- NSOpenGLPFAs )
-
-CONSTANT: attribute>NSOpenGLPFA-map H{
+PIXEL-FORMAT-ATTRIBUTE-TABLE: NSOpenGLPFA H{
{ double-buffered { $ NSOpenGLPFADoubleBuffer } }
{ stereo { $ NSOpenGLPFAStereo } }
{ offscreen { $ NSOpenGLPFAOffScreen } }
@@ -49,28 +48,20 @@ CONSTANT: attribute>NSOpenGLPFA-map H{
{ samples { $ NSOpenGLPFASamples } }
}
-M: object >NSOpenGLPFA
- drop { } ;
-M: symbol >NSOpenGLPFA
- attribute>NSOpenGLPFA-map at [ { } ] unless* ;
-M: pixel-format-attribute >NSOpenGLPFA
- dup class attribute>NSOpenGLPFA-map at
- [ swap value>> suffix ]
- [ drop { } ] if* ;
-
PRIVATE>
M: cocoa-ui-backend (make-pixel-format)
- [ >NSOpenGLPFA ] map concat 0 suffix >int-array
+ >NSOpenGLPFA-int-array
NSOpenGLPixelFormat -> alloc swap -> initWithAttributes: ;
M: cocoa-ui-backend (free-pixel-format)
-> release ;
M: cocoa-ui-backend (pixel-format-attribute)
- attribute>NSOpenGLPFA-map at
+ >NSOpenGLPFA
+ [ drop f ]
[ first 0 <int> [ swap 0 -> getValues:forAttribute:forVirtualScreen: ] keep *int ]
- [ drop f ] if* ;
+ if-empty ;
TUPLE: pasteboard handle ;
diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor
index 3032c2551f..5c16407135 100644
--- a/basis/ui/pixel-formats/pixel-formats.factor
+++ b/basis/ui/pixel-formats/pixel-formats.factor
@@ -1,4 +1,6 @@
-USING: accessors destructors kernel math ui.backend ;
+USING: accessors assocs classes destructors functors kernel
+lexer math parser sequences specialized-arrays.int ui.backend
+words.symbol ;
IN: ui.pixel-formats
SYMBOLS:
@@ -59,3 +61,32 @@ M: pixel-format dispose
: pixel-format-attribute ( pixel-format attribute-name -- value )
[ handle>> ] dip (pixel-format-attribute) ;
+<PRIVATE
+
+FUNCTOR: define-pixel-format-attribute-table ( NAME 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 0 suffix >int-array ;
+
+;FUNCTOR
+
+SYNTAX: PIXEL-FORMAT-ATTRIBUTE-TABLE:
+ scan scan-object define-pixel-format-attribute-table ;
+
+PRIVATE>
From 54e9447ec428e39757526678b1c7823e440f08e8 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 1 May 2009 20:07:14 -0500
Subject: [PATCH 15/27] adjust pixel format syntax. override offscreen-world
pixel-format-attributes instead of special-casing
---
basis/ui/backend/cocoa/cocoa.factor | 9 ++++-----
basis/ui/pixel-formats/pixel-formats.factor | 6 +++---
extra/ui/offscreen/offscreen.factor | 3 +++
3 files changed, 10 insertions(+), 8 deletions(-)
diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor
index ba0a7b9c7e..297996e9db 100755
--- a/basis/ui/backend/cocoa/cocoa.factor
+++ b/basis/ui/backend/cocoa/cocoa.factor
@@ -24,7 +24,7 @@ SINGLETON: cocoa-ui-backend
<PRIVATE
-PIXEL-FORMAT-ATTRIBUTE-TABLE: NSOpenGLPFA H{
+PIXEL-FORMAT-ATTRIBUTE-TABLE: NSOpenGLPFA { } H{
{ double-buffered { $ NSOpenGLPFADoubleBuffer } }
{ stereo { $ NSOpenGLPFAStereo } }
{ offscreen { $ NSOpenGLPFAOffScreen } }
@@ -148,13 +148,12 @@ M: cocoa-ui-backend raise-window* ( world -- )
{ [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } 3cleave ;
:: gadget-offscreen-context ( world -- context buffer )
- world world-pixel-format-attributes offscreen suffix
- <pixel-format> [
- :> pf
+ world [
+ nip :> pf
NSOpenGLContext -> alloc pf handle>> f -> initWithFormat:shareContext:
dup world pf offscreen-buffer
4 npick [ -> setOffScreen:width:height:rowbytes: ] dip
- ] with-disposal ;
+ ] with-world-pixel-format ;
M: cocoa-ui-backend (open-offscreen-buffer) ( world -- )
dup gadget-offscreen-context <offscreen-handle> >>handle drop ;
diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor
index 5c16407135..dc613604a6 100644
--- a/basis/ui/pixel-formats/pixel-formats.factor
+++ b/basis/ui/pixel-formats/pixel-formats.factor
@@ -63,7 +63,7 @@ M: pixel-format dispose
<PRIVATE
-FUNCTOR: define-pixel-format-attribute-table ( NAME TABLE -- )
+FUNCTOR: define-pixel-format-attribute-table ( NAME PERM TABLE -- )
>PFA DEFINES >${NAME}
>PFA-int-array DEFINES >${NAME}-int-array
@@ -82,11 +82,11 @@ M: pixel-format-attribute >PFA
[ drop { } ] if* ;
: >PFA-int-array ( attribute -- int-array )
- [ >PFA ] map concat 0 suffix >int-array ;
+ [ >PFA ] map concat PERM prepend 0 suffix >int-array ;
;FUNCTOR
SYNTAX: PIXEL-FORMAT-ATTRIBUTE-TABLE:
- scan scan-object define-pixel-format-attribute-table ;
+ scan scan-object scan-object define-pixel-format-attribute-table ;
PRIVATE>
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 } } } ;
+
: <offscreen-world> ( gadget title status -- world )
offscreen-world new-world ;
From 621fed2dd54c305de9d0e218f6cbd82f7a755a1c Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 2 May 2009 12:31:33 -0500
Subject: [PATCH 16/27] need to pass world as arg to pixel-format hooks
---
basis/ui/backend/cocoa/cocoa.factor | 6 +++---
basis/ui/gadgets/worlds/worlds.factor | 2 +-
basis/ui/pixel-formats/pixel-formats.factor | 18 +++++++++---------
3 files changed, 13 insertions(+), 13 deletions(-)
diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor
index 297996e9db..a4dbf670e2 100755
--- a/basis/ui/backend/cocoa/cocoa.factor
+++ b/basis/ui/backend/cocoa/cocoa.factor
@@ -51,14 +51,14 @@ PIXEL-FORMAT-ATTRIBUTE-TABLE: NSOpenGLPFA { } H{
PRIVATE>
M: cocoa-ui-backend (make-pixel-format)
- >NSOpenGLPFA-int-array
+ nip >NSOpenGLPFA-int-array
NSOpenGLPixelFormat -> alloc swap -> initWithAttributes: ;
M: cocoa-ui-backend (free-pixel-format)
- -> release ;
+ handle>> -> release ;
M: cocoa-ui-backend (pixel-format-attribute)
- >NSOpenGLPFA
+ [ handle>> ] [ >NSOpenGLPFA ] bi*
[ drop f ]
[ first 0 <int> [ swap 0 -> getValues:forAttribute:forVirtualScreen: ] keep *int ]
if-empty ;
diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor
index 0328d453d4..c66e59b292 100644
--- a/basis/ui/gadgets/worlds/worlds.factor
+++ b/basis/ui/gadgets/worlds/worlds.factor
@@ -157,5 +157,5 @@ M: world world-pixel-format-attributes
{ windowed double-buffered T{ depth-bits { value 16 } } } ;
: with-world-pixel-format ( world quot -- )
- [ dup world-pixel-format-attributes <pixel-format> ]
+ [ dup dup world-pixel-format-attributes <pixel-format> ]
dip with-disposal ; inline
diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor
index dc613604a6..98b1dab88e 100644
--- a/basis/ui/pixel-formats/pixel-formats.factor
+++ b/basis/ui/pixel-formats/pixel-formats.factor
@@ -43,23 +43,23 @@ TUPLE: buffer-level < pixel-format-attribute ;
TUPLE: sample-buffers < pixel-format-attribute ;
TUPLE: samples < pixel-format-attribute ;
-HOOK: (make-pixel-format) ui-backend ( attributes -- pixel-format-handle )
-HOOK: (free-pixel-format) ui-backend ( pixel-format-handle -- )
-HOOK: (pixel-format-attribute) ui-backend ( pixel-format-handle attribute-name -- value )
+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 attributes ;
+ERROR: invalid-pixel-format-attributes world attributes ;
-TUPLE: pixel-format handle ;
+TUPLE: pixel-format world handle ;
-: <pixel-format> ( attributes -- pixel-format )
- dup (make-pixel-format)
+: <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) ] when* f ] change-handle drop ;
+ [ (free-pixel-format) ] [ f >>handle drop ] bi ;
: pixel-format-attribute ( pixel-format attribute-name -- value )
- [ handle>> ] dip (pixel-format-attribute) ;
+ (pixel-format-attribute) ;
<PRIVATE
From 95f1ca3d9fb5d28616f0a2cc4b08fb6559ae80ec Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 2 May 2009 13:42:10 -0500
Subject: [PATCH 17/27] windows pixel-format backend
---
basis/ui/backend/windows/windows.factor | 174 ++++++++++++++++++++++--
basis/windows/opengl32/opengl32.factor | 16 ---
2 files changed, 160 insertions(+), 30 deletions(-)
diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 76c0dc4e01..21bf5c74eb 100755
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -10,11 +10,153 @@ 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 ;
IN: ui.backend.windows
SINGLETON: windows-ui-backend
+<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 } }
+ { 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 }
+ { software-rendered $ PFD_GENERIC_FORMAT }
+}
+
+: >pfd-flag ( attribute -- value )
+ pfd-flag-map at [ ] [ 0 ] if* ;
+
+: >pfd-flags ( attributes -- flags )
+ [ >pfd-flag ] map [ bitor ] binary-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 ;
@@ -477,21 +619,22 @@ 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 ( hWnd -- hDC ) GetDC dup win32-error=0/f ;
: get-rc ( hDC -- hRC )
dup wglCreateContext dup win32-error=0/f
[ wglMakeCurrent win32-error=0/f ] keep ;
-: setup-gl ( hwnd -- hDC hRC )
- get-dc dup windowed-pfd-dwFlags setup-pixel-format dup get-rc ;
+: set-pixel-format ( pixel-format hdc -- )
+ swap handle>> "PIXELFORMATDESCRIPTOR" <c-object> SetPixelFormat win32-error=0/f ;
+
+: setup-gl ( world hwnd -- hDC hRC )
+ get-dc
+ [ [ drop ] 2dip [ set-pixel-format ] [ ] [ get-rc ] tri ]
+ curry with-world-pixel-format ;
M: windows-ui-backend (open-window) ( world -- )
- [ create-window [ setup-gl ] keep ] keep
+ [ dup create-window [ setup-gl ] keep ] keep
[ f <win> ] keep
[ swap hWnd>> register-window ] 2keep
dupd (>>handle)
@@ -504,14 +647,17 @@ 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 -- hDC hRC hBitmap bits )
+ [
+ swap
+ make-offscreen-dc-and-bitmap [
+ [ set-pixel-format ]
+ [ get-rc ] bi
+ ] 2dip ;
+ ] with-world-pixel-format
M: windows-ui-backend (open-offscreen-buffer) ( world -- )
- dup dim>> setup-offscreen-gl <win-offscreen>
+ dup setup-offscreen-gl <win-offscreen>
>>handle drop ;
M: windows-ui-backend (close-offscreen-buffer) ( handle -- )
diff --git a/basis/windows/opengl32/opengl32.factor b/basis/windows/opengl32/opengl32.factor
index d54d142b1f..4173332dc3 100755
--- a/basis/windows/opengl32/opengl32.factor
+++ b/basis/windows/opengl32/opengl32.factor
@@ -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
From 623b16d048836ebd27d32db328b86e402e9736e0 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 2 May 2009 16:39:31 -0500
Subject: [PATCH 18/27] X11 backend for pixel formats
---
basis/ui/backend/cocoa/cocoa.factor | 4 ---
basis/ui/backend/x11/x11.factor | 44 +++++++++++++++++++++++++++--
basis/x11/glx/glx.factor | 11 --------
basis/x11/windows/windows.factor | 12 +++-----
4 files changed, 45 insertions(+), 26 deletions(-)
diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor
index a4dbf670e2..dd207aa4f9 100755
--- a/basis/ui/backend/cocoa/cocoa.factor
+++ b/basis/ui/backend/cocoa/cocoa.factor
@@ -22,8 +22,6 @@ C: <offscreen-handle> offscreen-handle
SINGLETON: cocoa-ui-backend
-<PRIVATE
-
PIXEL-FORMAT-ATTRIBUTE-TABLE: NSOpenGLPFA { } H{
{ double-buffered { $ NSOpenGLPFADoubleBuffer } }
{ stereo { $ NSOpenGLPFAStereo } }
@@ -48,8 +46,6 @@ PIXEL-FORMAT-ATTRIBUTE-TABLE: NSOpenGLPFA { } H{
{ samples { $ NSOpenGLPFASamples } }
}
-PRIVATE>
-
M: cocoa-ui-backend (make-pixel-format)
nip >NSOpenGLPFA-int-array
NSOpenGLPixelFormat -> alloc swap -> initWithAttributes: ;
diff --git a/basis/ui/backend/x11/x11.factor b/basis/ui/backend/x11/x11.factor
index fb78abe917..5192fa1075 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
+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*
+ [ drop f ] [
+ first [ dpy get ] 2dip
+ 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 ]
diff --git a/basis/x11/glx/glx.factor b/basis/x11/glx/glx.factor
index b459b55f46..67ac0e8cc1 100644
--- a/basis/x11/glx/glx.factor
+++ b/basis/x11/glx/glx.factor
@@ -95,17 +95,6 @@ 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 ;
From a7e2632faffedd4fb85b483fe0a6ab28731962f4 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 2 May 2009 16:46:58 -0500
Subject: [PATCH 19/27] check-world-pixel-format word that world subclasses can
override to verify that the chosen pixel format meets their needs
---
basis/ui/gadgets/worlds/worlds.factor | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor
index c66e59b292..885f4138ff 100644
--- a/basis/ui/gadgets/worlds/worlds.factor
+++ b/basis/ui/gadgets/worlds/worlds.factor
@@ -152,10 +152,15 @@ M: world handle-gesture ( gesture gadget -- ? )
GENERIC: world-pixel-format-attributes ( world -- attributes )
+GENERIC# check-world-pixel-format 1 ( world pixel-format -- )
+
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 with-disposal ; inline
+ dip [ 2dup check-world-pixel-format ] prepose with-disposal ; inline
From d96f6d3197b5b43b7c1f3007d9b9174f8b1698e1 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 2 May 2009 17:54:45 -0500
Subject: [PATCH 20/27] oops, forgot backing-store support on windows. also
"robust" is useless
---
basis/ui/backend/cocoa/cocoa.factor | 1 -
basis/ui/backend/windows/windows.factor | 2 ++
basis/ui/gadgets/worlds/worlds-docs.factor | 2 +-
basis/ui/pixel-formats/pixel-formats.factor | 1 -
4 files changed, 3 insertions(+), 3 deletions(-)
diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor
index dd207aa4f9..5b1b4b0c2a 100755
--- a/basis/ui/backend/cocoa/cocoa.factor
+++ b/basis/ui/backend/cocoa/cocoa.factor
@@ -30,7 +30,6 @@ PIXEL-FORMAT-ATTRIBUTE-TABLE: NSOpenGLPFA { } H{
{ windowed { $ NSOpenGLPFAWindow } }
{ accelerated { $ NSOpenGLPFAAccelerated } }
{ software-rendered { $ NSOpenGLPFASingleRenderer $ kCGLRendererGenericFloatID } }
- { robust { $ NSOpenGLPFARobust } }
{ backing-store { $ NSOpenGLPFABackingStore } }
{ multisampled { $ NSOpenGLPFAMultisample } }
{ supersampled { $ NSOpenGLPFASupersample } }
diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 21bf5c74eb..cc0c30f05e 100755
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -26,6 +26,7 @@ PIXEL-FORMAT-ATTRIBUTE-TABLE: WGL_ARB { $ WGL_SUPPORT_OPENGL_ARB 1 } H{
{ 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 } }
@@ -68,6 +69,7 @@ CONSTANT: pfd-flag-map H{
{ 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 }
}
diff --git a/basis/ui/gadgets/worlds/worlds-docs.factor b/basis/ui/gadgets/worlds/worlds-docs.factor
index e3c1226f22..ad9f3f8d4f 100644
--- 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 ui.pixel-formats ;
IN: ui.gadgets.worlds
HELP: user-input
diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor
index 98b1dab88e..8b09402b0f 100644
--- a/basis/ui/pixel-formats/pixel-formats.factor
+++ b/basis/ui/pixel-formats/pixel-formats.factor
@@ -11,7 +11,6 @@ SYMBOLS:
windowed
accelerated
software-rendered
- robust
backing-store
multisampled
supersampled
From af6bf6603eb6b107ae024dc8eee51aa4e5b54950 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 2 May 2009 18:22:45 -0500
Subject: [PATCH 21/27] docs for ui.pixel-formats
---
basis/ui/pixel-formats/authors.txt | 1 +
.../pixel-formats/pixel-formats-docs.factor | 190 ++++++++++++++++++
basis/ui/pixel-formats/pixel-formats.factor | 2 -
basis/ui/pixel-formats/summary.txt | 1 +
4 files changed, 192 insertions(+), 2 deletions(-)
create mode 100644 basis/ui/pixel-formats/authors.txt
create mode 100644 basis/ui/pixel-formats/pixel-formats-docs.factor
create mode 100644 basis/ui/pixel-formats/summary.txt
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..188a92d8b8
--- /dev/null
+++ b/basis/ui/pixel-formats/pixel-formats-docs.factor
@@ -0,0 +1,190 @@
+USING: destructors help.markup help.syntax kernel math multiline sequences ui.gadgets.worlds ;
+IN: ui.pixel-formats
+
+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"
diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor
index 8b09402b0f..125f79eded 100644
--- a/basis/ui/pixel-formats/pixel-formats.factor
+++ b/basis/ui/pixel-formats/pixel-formats.factor
@@ -37,8 +37,6 @@ TUPLE: stencil-bits < pixel-format-attribute ;
TUPLE: aux-buffers < pixel-format-attribute ;
-TUPLE: buffer-level < pixel-format-attribute ;
-
TUPLE: sample-buffers < pixel-format-attribute ;
TUPLE: samples < pixel-format-attribute ;
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
From 886d08733265b3213d905f82c94515c8e24de251 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 2 May 2009 19:44:08 -0500
Subject: [PATCH 22/27] ui.backend.windows code cleanup
---
basis/ui/backend/windows/windows.factor | 51 +++++++++++--------------
1 file changed, 23 insertions(+), 28 deletions(-)
diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index cc0c30f05e..eff8db238b 100755
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -16,6 +16,12 @@ 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{
@@ -217,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
@@ -621,26 +621,24 @@ M: windows-ui-backend do-events
f class-name-ptr set-global
f msg-obj set-global ;
-: get-dc ( hWnd -- hDC ) GetDC dup win32-error=0/f ;
+: get-dc ( world -- ) handle>> dup hWnd>> GetDC dup win32-error=0/f >>hDC drop ;
-: get-rc ( hDC -- hRC )
- dup wglCreateContext dup win32-error=0/f
- [ wglMakeCurrent win32-error=0/f ] keep ;
+: get-rc ( world -- )
+ handle>> dup hDC>> dup wglCreateContext dup win32-error=0/f
+ [ wglMakeCurrent win32-error=0/f ] keep >>hRC drop ;
: set-pixel-format ( pixel-format hdc -- )
swap handle>> "PIXELFORMATDESCRIPTOR" <c-object> SetPixelFormat win32-error=0/f ;
-: setup-gl ( world hwnd -- hDC hRC )
- get-dc
- [ [ drop ] 2dip [ set-pixel-format ] [ ] [ get-rc ] tri ]
- curry with-world-pixel-format ;
+: setup-gl ( world -- )
+ [ get-dc ] keep
+ [ swap [ hDC>> set-pixel-format ] [ get-rc ] bi ]
+ with-world-pixel-format ;
M: windows-ui-backend (open-window) ( world -- )
- [ dup create-window [ setup-gl ] keep ] keep
- [ f <win> ] keep
- [ swap hWnd>> register-window ] 2keep
- dupd (>>handle)
- hWnd>> show-window ;
+ [ dup create-window 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
@@ -650,17 +648,14 @@ M: win-base flush-gl-context ( handle -- )
hDC>> SwapBuffers win32-error=0/f ;
: setup-offscreen-gl ( world -- hDC hRC hBitmap bits )
- [
- swap
- make-offscreen-dc-and-bitmap [
- [ set-pixel-format ]
- [ get-rc ] bi
- ] 2dip ;
- ] with-world-pixel-format
+ dup [ handle>> ] [ dim>> ] bi make-offscreen-dc-and-bitmap
+ [ >>hDC ] [ >>hBitmap ] [ >>bits ] tri* drop [
+ swap [ hDC>> set-pixel-format ] [ get-rc ] bi
+ ] with-world-pixel-format ;
M: windows-ui-backend (open-offscreen-buffer) ( world -- )
- dup 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 ]
From aa142a1b52c2e99487a20430a30b9399e9ed058f Mon Sep 17 00:00:00 2001
From: "U-FROGGER\\erg" <erg@frogger.(none)>
Date: Sat, 2 May 2009 20:36:31 -0500
Subject: [PATCH 23/27] fix windows ui
---
basis/ui/backend/windows/windows.factor | 12 ++++++------
basis/ui/gadgets/worlds/worlds-docs.factor | 2 +-
basis/ui/gadgets/worlds/worlds.factor | 0
basis/windows/gdi32/gdi32.factor | 2 +-
4 files changed, 8 insertions(+), 8 deletions(-)
mode change 100644 => 100755 basis/ui/gadgets/worlds/worlds-docs.factor
mode change 100644 => 100755 basis/ui/gadgets/worlds/worlds.factor
diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index eff8db238b..24ae72740f 100755
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -11,7 +11,7 @@ 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 literals ui.pixel-formats
-ui.pixel-formats.private memoize ;
+ui.pixel-formats.private memoize classes ;
IN: ui.backend.windows
SINGLETON: windows-ui-backend
@@ -83,7 +83,7 @@ CONSTANT: pfd-flag-map H{
pfd-flag-map at [ ] [ 0 ] if* ;
: >pfd-flags ( attributes -- flags )
- [ >pfd-flag ] map [ bitor ] binary-reduce
+ [ >pfd-flag ] [ bitor ] map-reduce
PFD_SUPPORT_OPENGL bitor ;
: attr-value ( attributes name -- value )
@@ -632,11 +632,11 @@ M: windows-ui-backend do-events
: setup-gl ( world -- )
[ get-dc ] keep
- [ swap [ hDC>> set-pixel-format ] [ get-rc ] bi ]
+ [ swap [ handle>> hDC>> set-pixel-format ] [ get-rc ] bi ]
with-world-pixel-format ;
M: windows-ui-backend (open-window) ( world -- )
- [ dup create-window f f <win> >>handle setup-gl ]
+ [ dup create-window [ f f ] dip f f <win> >>handle setup-gl ]
[ dup handle>> hWnd>> register-window ]
[ handle>> hWnd>> show-window ] tri ;
@@ -647,10 +647,10 @@ M: win-base select-gl-context ( handle -- )
M: win-base flush-gl-context ( handle -- )
hDC>> SwapBuffers win32-error=0/f ;
-: setup-offscreen-gl ( world -- hDC hRC hBitmap bits )
+: setup-offscreen-gl ( world -- )
dup [ handle>> ] [ dim>> ] bi make-offscreen-dc-and-bitmap
[ >>hDC ] [ >>hBitmap ] [ >>bits ] tri* drop [
- swap [ hDC>> set-pixel-format ] [ get-rc ] bi
+ swap [ handle>> hDC>> set-pixel-format ] [ get-rc ] bi
] with-world-pixel-format ;
M: windows-ui-backend (open-offscreen-buffer) ( world -- )
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 ad9f3f8d4f..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 sequences strings ui.pixel-formats ;
+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
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
From 644c42d4e348eb033c9ccac82646ad36d1104e97 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 2 May 2009 21:52:18 -0500
Subject: [PATCH 24/27] "ui-backend" variable can't be used to choose text
backend
---
basis/ui/text/text.factor | 12 +++++-------
1 file changed, 5 insertions(+), 7 deletions(-)
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
From cc244cb6721bca042cae946969087c98cf812b0b Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 2 May 2009 21:54:25 -0500
Subject: [PATCH 25/27] break code->code docs<-docs dependency
---
basis/ui/gadgets/worlds/worlds.factor | 4 ----
basis/ui/pixel-formats/pixel-formats-docs.factor | 9 ++++++++-
basis/ui/pixel-formats/pixel-formats.factor | 5 +++++
3 files changed, 13 insertions(+), 5 deletions(-)
diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor
index 885f4138ff..171272dfc1 100755
--- a/basis/ui/gadgets/worlds/worlds.factor
+++ b/basis/ui/gadgets/worlds/worlds.factor
@@ -150,10 +150,6 @@ M: world handle-gesture ( gesture gadget -- ? )
: close-global ( world global -- )
[ get-global find-world eq? ] keep '[ f _ set-global ] when ;
-GENERIC: world-pixel-format-attributes ( world -- attributes )
-
-GENERIC# check-world-pixel-format 1 ( world pixel-format -- )
-
M: world world-pixel-format-attributes
drop
{ windowed double-buffered T{ depth-bits { value 16 } } } ;
diff --git a/basis/ui/pixel-formats/pixel-formats-docs.factor b/basis/ui/pixel-formats/pixel-formats-docs.factor
index 188a92d8b8..6f2485d249 100644
--- a/basis/ui/pixel-formats/pixel-formats-docs.factor
+++ b/basis/ui/pixel-formats/pixel-formats-docs.factor
@@ -1,6 +1,13 @@
-USING: destructors help.markup help.syntax kernel math multiline sequences ui.gadgets.worlds ;
+USING: destructors help.markup help.syntax kernel math multiline sequences
+vocabs.parser words ;
IN: ui.pixel-formats
+! break circular dependency
+<<
+ "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 }
diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor
index 125f79eded..52abf44362 100644
--- a/basis/ui/pixel-formats/pixel-formats.factor
+++ b/basis/ui/pixel-formats/pixel-formats.factor
@@ -87,3 +87,8 @@ 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 -- )
+
From a0c8d0ae9e9d19b18cf4311832b5e798f50a7d27 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 2 May 2009 21:55:19 -0500
Subject: [PATCH 26/27] fix x11 backend bugs
---
basis/ui/backend/x11/x11.factor | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/basis/ui/backend/x11/x11.factor b/basis/ui/backend/x11/x11.factor
index 5192fa1075..76fd9fa30c 100755
--- a/basis/ui/backend/x11/x11.factor
+++ b/basis/ui/backend/x11/x11.factor
@@ -7,7 +7,7 @@ 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
@@ -59,8 +59,8 @@ M: x11-ui-backend (free-pixel-format)
M: x11-ui-backend (pixel-format-attribute)
[ dpy get ] 2dip
[ handle>> ] [ >glx-visual ] bi*
- [ drop f ] [
- first [ dpy get ] 2dip
+ [ 2drop f ] [
+ first
0 <int> [ glXGetConfig drop ] keep *int
] if-empty ;
From fa524ce213d20223122fc898928575e05fb6e960 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sat, 2 May 2009 22:13:01 -0500
Subject: [PATCH 27/27] fix circular dependency for reals
---
basis/ui/pixel-formats/pixel-formats-docs.factor | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/basis/ui/pixel-formats/pixel-formats-docs.factor b/basis/ui/pixel-formats/pixel-formats-docs.factor
index 6f2485d249..207b757908 100644
--- a/basis/ui/pixel-formats/pixel-formats-docs.factor
+++ b/basis/ui/pixel-formats/pixel-formats-docs.factor
@@ -1,9 +1,10 @@
USING: destructors help.markup help.syntax kernel math multiline sequences
-vocabs.parser words ;
+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+)
>>