-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" } }
{ $description "Outputs the current mouse location." } ;
ARTICLE: "cocoa-view-utils" "Cocoa view utilities"
-{ $subsection <PixelFormat> }
{ $subsection <GLView> }
{ $subsection view-dim }
{ $subsection mouse-location } ;
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: ;
--- /dev/null
+! 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"
--- /dev/null
+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
--- /dev/null
+! (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 ;
--- /dev/null
+Expression interpolation into sequence literals
--- /dev/null
+extensions
+syntax
! 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 ;
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
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
] 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 ;
-> 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 ;
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
: 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
-USING: destructors math ui.backend ;
+USING: accessors destructors kernel math ui.backend ;
IN: ui.pixel-formats
-SINGLETONS:
+SYMBOLS:
double-buffered
stereo
offscreen
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 } ;
+ERROR: invalid-pixel-format-attributes attributes ;
+
+TUPLE: pixel-format handle ;
: <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 ;
! 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)
+++ /dev/null
-! 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"
+++ /dev/null
-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
+++ /dev/null
-! (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 ;
+++ /dev/null
-Expression interpolation into sequence literals
+++ /dev/null
-extensions
-syntax