]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of git://factorcode.org/git/factor
authorJoe Groff <arcata@gmail.com>
Fri, 1 May 2009 02:36:54 +0000 (21:36 -0500)
committerJoe Groff <arcata@gmail.com>
Fri, 1 May 2009 02:36:54 +0000 (21:36 -0500)
basis/delegate/delegate-docs.factor
basis/math/rectangles/rectangles-tests.factor
basis/math/rectangles/rectangles.factor
basis/opengl/gl/windows/windows.factor
basis/ui/pixel-formats/pixel-formats.factor [new file with mode: 0644]
basis/windows/opengl32/opengl32.factor

index 42b727852e3491162fdc84ec29594f0eb28613a9..42e770aa75eb713828c83becb1df061d1e29e536 100644 (file)
@@ -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
 
index ca722859d261f6616faabe77ea2f32bcc9558690..7959d98f929d5dd09f9e2140611a33b9147b5681 100644 (file)
@@ -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
index 1d9c91328f5c3f5985c9e603100245a13f7e142d..90174d144e5825ceb483dde2138dada9a7e307ad 100644 (file)
@@ -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
index 8f48f60d3c0904c5874fbc64275e9d3494c00585..c8a179edf520a65ac7a95750ba200e384c9eae22 100644 (file)
@@ -1,6 +1,11 @@
-USING: kernel windows.opengl32 ;
+USING: alien.syntax kernel windows.types ;
 IN: opengl.gl.windows
 
+LIBRARY: gl
+
+FUNCTION: HGLRC wglGetCurrentContext ( ) ;
+FUNCTION: void* wglGetProcAddress ( char* name ) ;
+
 : gl-function-context ( -- context ) wglGetCurrentContext ; inline
 : gl-function-address ( name -- address ) wglGetProcAddress ; inline
 : gl-function-calling-convention ( -- str ) "stdcall" ; inline
diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor
new file mode 100644 (file)
index 0000000..09450f2
--- /dev/null
@@ -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) ;
+
index d0b396eba22e64581130cfc50338dbd32efbc8e3..d5e8fe9a662c8d1f71de95b0995256381bd5b42e 100755 (executable)
@@ -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 opengl.gl.extensions opengl.gl.windows ;
 IN: windows.opengl32
 
 ! PIXELFORMATDESCRIPTOR flags
@@ -100,5 +100,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? ;