]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge branch 'master' of http://factorcode.org/git/factor
authorJoe Groff <arcata@gmail.com>
Fri, 1 May 2009 18:01:04 +0000 (13:01 -0500)
committerJoe Groff <arcata@gmail.com>
Fri, 1 May 2009 18:01:04 +0000 (13:01 -0500)
24 files changed:
basis/cocoa/views/views-docs.factor
basis/cocoa/views/views.factor
basis/delegate/delegate-docs.factor
basis/literals/authors.txt [new file with mode: 0644]
basis/literals/literals-docs.factor [new file with mode: 0644]
basis/literals/literals-tests.factor [new file with mode: 0644]
basis/literals/literals.factor [new file with mode: 0644]
basis/literals/summary.txt [new file with mode: 0644]
basis/literals/tags.txt [new file with mode: 0644]
basis/math/rectangles/rectangles-tests.factor
basis/math/rectangles/rectangles.factor
basis/opengl/gl/windows/windows.factor
basis/ui/backend/cocoa/cocoa.factor
basis/ui/backend/cocoa/views/views.factor
basis/ui/gadgets/worlds/worlds.factor
basis/ui/pixel-formats/pixel-formats.factor [new file with mode: 0644]
basis/windows/opengl32/opengl32.factor
basis/x11/glx/glx.factor
extra/literals/authors.txt [deleted file]
extra/literals/literals-docs.factor [deleted file]
extra/literals/literals-tests.factor [deleted file]
extra/literals/literals.factor [deleted file]
extra/literals/summary.txt [deleted file]
extra/literals/tags.txt [deleted file]

index 3b533f98c38a4eed90c0877aa22a5ed8ce119f95..871326fcd452ec328eada84b1cb4bad7531bec33 100644 (file)
@@ -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 } ;
index 3c60a6a7c1a276fecdc6321a33d60dee97d970ba..f65fddac58edcb2726b7128deb789f0c334872cd 100644 (file)
@@ -42,39 +42,10 @@ CONSTANT: NSOpenGLPFAAllowOfflineRenderers 96
 CONSTANT: NSOpenGLPFAVirtualScreenCount 128
 CONSTANT: NSOpenGLCPSwapInterval 222
 
-<PRIVATE
-
-SYMBOL: software-renderer?
-SYMBOL: multisample?
-
-PRIVATE>
-
-: with-software-renderer ( quot -- )
-    [ t software-renderer? ] dip with-variable ; inline
-
-: with-multisample ( quot -- )
-    [ t multisample? ] dip with-variable ; inline
-
-: <PixelFormat> ( attributes -- pixelfmt )
-    NSOpenGLPixelFormat -> alloc swap [
-        %
-        NSOpenGLPFADepthSize , 16 ,
-        software-renderer? get [
-            NSOpenGLPFARendererID , kCGLRendererGenericFloatID ,
-        ] when
-        multisample? get [
-            NSOpenGLPFASupersample ,
-            NSOpenGLPFASampleBuffers , 1 ,
-            NSOpenGLPFASamples , 8 ,
-        ] when
-        0 ,
-    ] int-array{ } make
-    -> initWithAttributes:
-    -> autorelease ;
-
-: <GLView> ( class dim -- view )
-    [ -> alloc 0 0 ] dip first2 <CGRect>
-    NSOpenGLPFAWindow NSOpenGLPFADoubleBuffer 2array <PixelFormat>
+: <GLView> ( class dim pixel-format -- view )
+    [ -> alloc ]
+    [ [ 0 0 ] dip first2 <CGRect> ]
+    [ handle>> ] tri*
     -> initWithFrame:pixelFormat:
     dup 1 -> setPostsBoundsChangedNotifications:
     dup 1 -> setPostsFrameChangedNotifications: ;
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
 
diff --git a/basis/literals/authors.txt b/basis/literals/authors.txt
new file mode 100644 (file)
index 0000000..f13c9c1
--- /dev/null
@@ -0,0 +1 @@
+Joe Groff
diff --git a/basis/literals/literals-docs.factor b/basis/literals/literals-docs.factor
new file mode 100644 (file)
index 0000000..0d61dcb
--- /dev/null
@@ -0,0 +1,61 @@
+! Copyright (C) 2008 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel multiline ;
+IN: literals
+
+HELP: $
+{ $syntax "$ word" }
+{ $description "Executes " { $snippet "word" } " at parse time and adds the result(s) to the parser accumulator." }
+{ $notes { $snippet "word" } "'s definition is looked up and " { $link call } "ed at parse time, so words that reference words in the current compilation unit cannot be used with " { $snippet "$" } "." }
+{ $examples
+
+    { $example <"
+USING: kernel literals prettyprint ;
+IN: scratchpad
+
+CONSTANT: five 5
+{ $ five } .
+    "> "{ 5 }" }
+
+    { $example <"
+USING: kernel literals prettyprint ;
+IN: scratchpad
+
+<< : seven-eleven ( -- a b ) 7 11 ; >>
+{ $ seven-eleven } .
+    "> "{ 7 11 }" }
+
+} ;
+
+HELP: $[
+{ $syntax "$[ code ]" }
+{ $description "Calls " { $snippet "code" } " at parse time and adds the result(s) to the parser accumulator." }
+{ $notes "Since " { $snippet "code" } " is " { $link call } "ed at parse time, it cannot reference any words defined in the same compilation unit." }
+{ $examples
+
+    { $example <"
+USING: kernel literals math prettyprint ;
+IN: scratchpad
+
+<< CONSTANT: five 5 >>
+{ $[ five dup 1+ dup 2 + ] } .
+    "> "{ 5 6 8 }" }
+
+} ;
+
+{ POSTPONE: $ POSTPONE: $[ } related-words
+
+ARTICLE: "literals" "Interpolating code results into literal values"
+"The " { $vocab-link "literals" } " vocabulary contains words to run code at parse time and insert the results into more complex literal values."
+{ $example <"
+USING: kernel literals math prettyprint ;
+IN: scratchpad
+
+<< CONSTANT: five 5 >>
+{ $ five $[ five dup 1+ dup 2 + ] } .
+    "> "{ 5 5 6 8 }" }
+{ $subsection POSTPONE: $ }
+{ $subsection POSTPONE: $[ }
+;
+
+ABOUT: "literals"
diff --git a/basis/literals/literals-tests.factor b/basis/literals/literals-tests.factor
new file mode 100644 (file)
index 0000000..024c94e
--- /dev/null
@@ -0,0 +1,21 @@
+USING: kernel literals math tools.test ;
+IN: literals.tests
+
+<<
+: six-six-six ( -- a b c ) 6 6 6 ;
+>>
+
+: five ( -- a ) 5 ;
+: seven-eleven ( -- b c ) 7 11 ;
+
+[ { 5 } ] [ { $ five } ] unit-test
+[ { 7 11 } ] [ { $ seven-eleven } ] unit-test
+[ { 6 6 6 } ] [ { $ six-six-six } ] unit-test
+
+[ { 6 6 6 7 } ] [ { $ six-six-six 7 } ] unit-test
+
+[ { 8 8 8 } ] [ { $[ six-six-six [ 2 + ] tri@ ] } ] unit-test
+
+[ { 0.5 2.0 } ] [ { $[ 1.0 2.0 / ] 2.0 } ] unit-test
+
+[ { 1.0 { 0.5 1.5 } 4.0 } ] [ { 1.0 { $[ 1.0 2.0 / ] 1.5 } $[ 2.0 2.0 * ] } ] unit-test
diff --git a/basis/literals/literals.factor b/basis/literals/literals.factor
new file mode 100644 (file)
index 0000000..e55d78a
--- /dev/null
@@ -0,0 +1,6 @@
+! (c) Joe Groff, see license for details
+USING: accessors continuations kernel parser words quotations vectors ;
+IN: literals
+
+SYNTAX: $ scan-word [ def>> call ] curry with-datastack >vector ;
+SYNTAX: $[ parse-quotation with-datastack >vector ;
diff --git a/basis/literals/summary.txt b/basis/literals/summary.txt
new file mode 100644 (file)
index 0000000..dfeb9fe
--- /dev/null
@@ -0,0 +1 @@
+Expression interpolation into sequence literals
diff --git a/basis/literals/tags.txt b/basis/literals/tags.txt
new file mode 100644 (file)
index 0000000..4f4a20b
--- /dev/null
@@ -0,0 +1,2 @@
+extensions
+syntax
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
index 362305c8f70a4a32cdcf793babfaadd934bfe883..8a91dfd94deadbada6274ed2bc02d165776099a3 100755 (executable)
@@ -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
-cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
-cocoa.windows cocoa.classes cocoa.nibs sequences ui ui.private
-ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
-ui.backend.cocoa.views core-foundation core-foundation.run-loop
-core-graphics.types threads math.rectangles fry libc
-generalizations alien.c-types cocoa.views
-combinators io.thread locals ;
+USING: accessors alien.c-types arrays assocs classes cocoa
+cocoa.application cocoa.classes cocoa.messages cocoa.nibs
+cocoa.pasteboard cocoa.runtime cocoa.subclassing cocoa.types
+cocoa.views cocoa.windows combinators command-line
+core-foundation core-foundation.run-loop core-graphics
+core-graphics.types destructors fry generalizations io.thread
+kernel libc literals locals math math.rectangles memory
+namespaces sequences specialized-arrays.int threads ui
+ui.backend ui.backend.cocoa.views ui.clipboards ui.gadgets
+ui.gadgets.worlds ui.pixel-formats ui.private words.symbol ;
 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 0 suffix >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 ]
+    [ drop f ] if* ;
+
 TUPLE: pasteboard handle ;
 
 C: <pasteboard> pasteboard
@@ -70,7 +122,8 @@ M: cocoa-ui-backend fullscreen* ( world -- ? )
     handle>> view>> -> isInFullScreenMode zero? not ;
 
 M:: cocoa-ui-backend (open-window) ( world -- )
-    world dim>> <FactorView> :> view
+    world [ [ dim>> ] dip <FactorView> ]
+    with-world-pixel-format :> view
     view world world>NSRect <ViewWindow> :> window
     view -> release
     world view register-window
@@ -97,18 +150,20 @@ 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
+        4 npick [ -> setOffScreen:width:height:rowbytes: ] dip
+    ] with-disposal ;
 
 M: cocoa-ui-backend (open-offscreen-buffer) ( world -- )
     dup gadget-offscreen-context <offscreen-handle> >>handle drop ;
index 602c9bec73c188e2a6d0656870dcd11c8534ac4c..4a16e3bd376b809679e1137ddbc35bcf17cf1838 100644 (file)
@@ -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 ;
index a186de76709cbe4197514c2f26f243665de07083..0328d453d4f2ab56cff8d07dd168da20b9b89ebe 100644 (file)
@@ -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,13 @@ 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
+    drop
+    { 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
new file mode 100644 (file)
index 0000000..3c41926
--- /dev/null
@@ -0,0 +1,61 @@
+USING: accessors destructors kernel math ui.backend ;
+IN: ui.pixel-formats
+
+SYMBOLS:
+    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 )
+
+ERROR: invalid-pixel-format-attributes attributes ;
+
+TUPLE: pixel-format { handle read-only } ;
+
+: <pixel-format> ( attributes -- pixel-format )
+    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 ;
+
+: 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? ;
index dc6157b87fe94cdb0a0324e40da95caa6ebc89e9..b459b55f4612bda7e3f33cf58bef7d92cc773b66 100644 (file)
@@ -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)
 
diff --git a/extra/literals/authors.txt b/extra/literals/authors.txt
deleted file mode 100644 (file)
index f13c9c1..0000000
+++ /dev/null
@@ -1 +0,0 @@
-Joe Groff
diff --git a/extra/literals/literals-docs.factor b/extra/literals/literals-docs.factor
deleted file mode 100644 (file)
index 0d61dcb..0000000
+++ /dev/null
@@ -1,61 +0,0 @@
-! Copyright (C) 2008 Joe Groff.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel multiline ;
-IN: literals
-
-HELP: $
-{ $syntax "$ word" }
-{ $description "Executes " { $snippet "word" } " at parse time and adds the result(s) to the parser accumulator." }
-{ $notes { $snippet "word" } "'s definition is looked up and " { $link call } "ed at parse time, so words that reference words in the current compilation unit cannot be used with " { $snippet "$" } "." }
-{ $examples
-
-    { $example <"
-USING: kernel literals prettyprint ;
-IN: scratchpad
-
-CONSTANT: five 5
-{ $ five } .
-    "> "{ 5 }" }
-
-    { $example <"
-USING: kernel literals prettyprint ;
-IN: scratchpad
-
-<< : seven-eleven ( -- a b ) 7 11 ; >>
-{ $ seven-eleven } .
-    "> "{ 7 11 }" }
-
-} ;
-
-HELP: $[
-{ $syntax "$[ code ]" }
-{ $description "Calls " { $snippet "code" } " at parse time and adds the result(s) to the parser accumulator." }
-{ $notes "Since " { $snippet "code" } " is " { $link call } "ed at parse time, it cannot reference any words defined in the same compilation unit." }
-{ $examples
-
-    { $example <"
-USING: kernel literals math prettyprint ;
-IN: scratchpad
-
-<< CONSTANT: five 5 >>
-{ $[ five dup 1+ dup 2 + ] } .
-    "> "{ 5 6 8 }" }
-
-} ;
-
-{ POSTPONE: $ POSTPONE: $[ } related-words
-
-ARTICLE: "literals" "Interpolating code results into literal values"
-"The " { $vocab-link "literals" } " vocabulary contains words to run code at parse time and insert the results into more complex literal values."
-{ $example <"
-USING: kernel literals math prettyprint ;
-IN: scratchpad
-
-<< CONSTANT: five 5 >>
-{ $ five $[ five dup 1+ dup 2 + ] } .
-    "> "{ 5 5 6 8 }" }
-{ $subsection POSTPONE: $ }
-{ $subsection POSTPONE: $[ }
-;
-
-ABOUT: "literals"
diff --git a/extra/literals/literals-tests.factor b/extra/literals/literals-tests.factor
deleted file mode 100644 (file)
index 024c94e..0000000
+++ /dev/null
@@ -1,21 +0,0 @@
-USING: kernel literals math tools.test ;
-IN: literals.tests
-
-<<
-: six-six-six ( -- a b c ) 6 6 6 ;
->>
-
-: five ( -- a ) 5 ;
-: seven-eleven ( -- b c ) 7 11 ;
-
-[ { 5 } ] [ { $ five } ] unit-test
-[ { 7 11 } ] [ { $ seven-eleven } ] unit-test
-[ { 6 6 6 } ] [ { $ six-six-six } ] unit-test
-
-[ { 6 6 6 7 } ] [ { $ six-six-six 7 } ] unit-test
-
-[ { 8 8 8 } ] [ { $[ six-six-six [ 2 + ] tri@ ] } ] unit-test
-
-[ { 0.5 2.0 } ] [ { $[ 1.0 2.0 / ] 2.0 } ] unit-test
-
-[ { 1.0 { 0.5 1.5 } 4.0 } ] [ { 1.0 { $[ 1.0 2.0 / ] 1.5 } $[ 2.0 2.0 * ] } ] unit-test
diff --git a/extra/literals/literals.factor b/extra/literals/literals.factor
deleted file mode 100644 (file)
index e55d78a..0000000
+++ /dev/null
@@ -1,6 +0,0 @@
-! (c) Joe Groff, see license for details
-USING: accessors continuations kernel parser words quotations vectors ;
-IN: literals
-
-SYNTAX: $ scan-word [ def>> call ] curry with-datastack >vector ;
-SYNTAX: $[ parse-quotation with-datastack >vector ;
diff --git a/extra/literals/summary.txt b/extra/literals/summary.txt
deleted file mode 100644 (file)
index dfeb9fe..0000000
+++ /dev/null
@@ -1 +0,0 @@
-Expression interpolation into sequence literals
diff --git a/extra/literals/tags.txt b/extra/literals/tags.txt
deleted file mode 100644 (file)
index 4f4a20b..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-extensions
-syntax