From 32dfcd36ac5213bee3b361348239245ddbf67dd2 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 10 Sep 2008 20:19:57 -0700 Subject: [PATCH 1/9] more cocoa 64-bit type fixes --- basis/cocoa/messages/messages.factor | 12 +++---- basis/cocoa/types/types.factor | 54 ++++++++++++++++++---------- basis/ui/cocoa/views/views.factor | 4 +-- 3 files changed, 43 insertions(+), 27 deletions(-) diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index 7be649416c..ba7034d012 100755 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -108,12 +108,12 @@ H{ { "c" "char" } { "i" "int" } { "s" "short" } - { "l" "long" } + { "l" "int" } { "q" "longlong" } { "C" "uchar" } { "I" "uint" } { "S" "ushort" } - { "L" "ulong" } + { "L" "uint" } { "Q" "ulonglong" } { "f" "float" } { "d" "double" } @@ -133,14 +133,14 @@ objc>alien-types get [ swap ] assoc-map "ptrdiff_t" heap-size { { 4 [ H{ { "NSPoint" "{_NSPoint=ff}" } - { "NSRect" "{_NSRect=ffff}" } + { "NSRect" "{_NSRect={_NSPoint=ff}{_NSSize=ff}}" } { "NSSize" "{_NSSize=ff}" } { "NSRange" "{_NSRange=II}" } } ] } { 8 [ H{ - { "NSPoint" "{_NSPoint=dd}" } - { "NSRect" "{_NSRect=dddd}" } - { "NSSize" "{_NSSize=dd}" } + { "NSPoint" "{CGPoint=dd}" } + { "NSRect" "{CGRect={CGPoint=dd}{CGSize=dd}}" } + { "NSSize" "{CGSize=dd}" } { "NSRange" "{_NSRange=QQ}" } } ] } } case diff --git a/basis/cocoa/types/types.factor b/basis/cocoa/types/types.factor index 6e65bc1a72..acc717a61c 100644 --- a/basis/cocoa/types/types.factor +++ b/basis/cocoa/types/types.factor @@ -10,25 +10,6 @@ TYPEDEF: ulong NSUInteger { 8 [ "double" ] } } case "CGFloat" typedef >> -C-STRUCT: NSRect - { "CGFloat" "x" } - { "CGFloat" "y" } - { "CGFloat" "w" } - { "CGFloat" "h" } ; - -TYPEDEF: NSRect _NSRect -TYPEDEF: NSRect CGRect - -: ( x y w h -- rect ) - "NSRect" - [ set-NSRect-h ] keep - [ set-NSRect-w ] keep - [ set-NSRect-y ] keep - [ set-NSRect-x ] keep ; - -: NSRect-x-y ( alien -- origin-x origin-y ) - [ NSRect-x ] keep NSRect-y ; - C-STRUCT: NSPoint { "CGFloat" "x" } { "CGFloat" "y" } ; @@ -53,6 +34,41 @@ TYPEDEF: NSPoint CGPoint [ set-NSSize-h ] keep [ set-NSSize-w ] keep ; +C-STRUCT: NSRect + { "NSPoint" "origin" } + { "NSSize" "size" } ; + +TYPEDEF: NSRect _NSRect +TYPEDEF: NSRect CGRect + +: NSRect-x ( NSRect -- x ) + NSRect-origin NSPoint-x ; inline +: NSRect-y ( NSRect -- y ) + NSRect-origin NSPoint-y ; inline +: NSRect-w ( NSRect -- w ) + NSRect-size NSSize-w ; inline +: NSRect-h ( NSRect -- h ) + NSRect-size NSSize-h ; inline + +: set-NSRect-x ( x NSRect -- ) + NSRect-origin set-NSPoint-x ; inline +: set-NSRect-y ( y NSRect -- ) + NSRect-origin set-NSPoint-y ; inline +: set-NSRect-w ( w NSRect -- ) + NSRect-size set-NSSize-w ; inline +: set-NSRect-h ( h NSRect -- ) + NSRect-size set-NSSize-h ; inline + +: ( x y w h -- rect ) + "NSRect" + [ set-NSRect-h ] keep + [ set-NSRect-w ] keep + [ set-NSRect-y ] keep + [ set-NSRect-x ] keep ; + +: NSRect-x-y ( alien -- origin-x origin-y ) + [ NSRect-x ] keep NSRect-y ; + C-STRUCT: NSRange { "NSUInteger" "location" } { "NSUInteger" "length" } ; diff --git a/basis/ui/cocoa/views/views.factor b/basis/ui/cocoa/views/views.factor index 45ab8ac0ce..772770133d 100755 --- a/basis/ui/cocoa/views/views.factor +++ b/basis/ui/cocoa/views/views.factor @@ -128,8 +128,8 @@ CLASS: { } ! Rendering -{ "drawRect:" "void" { "id" "SEL" "id" "NSRect" } - [ 3drop window relayout-1 ] +{ "drawRect:" "void" { "id" "SEL" "NSRect" } + [ 2drop window relayout-1 ] } ! Events From 6575c068165295b8757c8768e61fd22b385d31a8 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 10 Sep 2008 21:28:38 -0700 Subject: [PATCH 2/9] oops--broke the alien>objc-types reverse mapping --- basis/cocoa/messages/messages.factor | 22 +++++++++++++++++----- basis/cocoa/types/types.factor | 7 ++++++- 2 files changed, 23 insertions(+), 6 deletions(-) diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index ba7034d012..623bfc961a 100755 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -108,22 +108,34 @@ H{ { "c" "char" } { "i" "int" } { "s" "short" } - { "l" "int" } - { "q" "longlong" } { "C" "uchar" } { "I" "uint" } { "S" "ushort" } - { "L" "uint" } - { "Q" "ulonglong" } { "f" "float" } { "d" "double" } { "B" "bool" } { "v" "void" } { "*" "char*" } + { "?" "unknown_type" } { "@" "id" } { "#" "id" } { ":" "SEL" } -} objc>alien-types set-global +} +"ptrdiff_t" heap-size { + { 4 [ H{ + { "l" "long" } + { "q" "longlong" } + { "L" "ulong" } + { "Q" "ulonglong" } + } ] } + { 8 [ H{ + { "l" "long32" } + { "q" "long" } + { "L" "ulong32" } + { "Q" "ulong" } + } ] } +} case +assoc-union objc>alien-types set-global ! The transpose of the above map SYMBOL: alien>objc-types diff --git a/basis/cocoa/types/types.factor b/basis/cocoa/types/types.factor index acc717a61c..d02865fe43 100644 --- a/basis/cocoa/types/types.factor +++ b/basis/cocoa/types/types.factor @@ -27,7 +27,7 @@ C-STRUCT: NSSize { "CGFloat" "h" } ; TYPEDEF: NSSize _NSSize -TYPEDEF: NSPoint CGPoint +TYPEDEF: NSSize CGSize : ( w h -- size ) "NSSize" @@ -75,6 +75,11 @@ C-STRUCT: NSRange TYPEDEF: NSRange _NSRange +! The "lL" type encodings refer to 32-bit values even in 64-bit mode +TYPEDEF: int long32 +TYPEDEF: uint long32 +TYPEDEF: void* unknown_type + : ( length location -- size ) "NSRange" [ set-NSRange-length ] keep From 8c8dd51136e5e2c1fa8e99c550766b9e501ddeb1 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 10 Sep 2008 21:40:41 -0700 Subject: [PATCH 3/9] one more cocoa type bug --- basis/cocoa/messages/messages.factor | 22 ++++++++++++++-------- basis/ui/cocoa/views/views.factor | 2 +- 2 files changed, 15 insertions(+), 9 deletions(-) diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index 623bfc961a..1b804c3cf1 100755 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -144,16 +144,22 @@ objc>alien-types get [ swap ] assoc-map ! A hack... "ptrdiff_t" heap-size { { 4 [ H{ - { "NSPoint" "{_NSPoint=ff}" } - { "NSRect" "{_NSRect={_NSPoint=ff}{_NSSize=ff}}" } - { "NSSize" "{_NSSize=ff}" } - { "NSRange" "{_NSRange=II}" } + { "NSPoint" "{_NSPoint=ff}" } + { "NSRect" "{_NSRect={_NSPoint=ff}{_NSSize=ff}}" } + { "NSSize" "{_NSSize=ff}" } + { "NSRange" "{_NSRange=II}" } + { "NSInteger" "i" } + { "NSUInteger" "I" } + { "CGFloat" "f" } } ] } { 8 [ H{ - { "NSPoint" "{CGPoint=dd}" } - { "NSRect" "{CGRect={CGPoint=dd}{CGSize=dd}}" } - { "NSSize" "{CGSize=dd}" } - { "NSRange" "{_NSRange=QQ}" } + { "NSPoint" "{CGPoint=dd}" } + { "NSRect" "{CGRect={CGPoint=dd}{CGSize=dd}}" } + { "NSSize" "{CGSize=dd}" } + { "NSRange" "{_NSRange=QQ}" } + { "NSInteger" "q" } + { "NSUInteger" "Q" } + { "CGFloat" "d" } } ] } } case assoc-union alien>objc-types set-global diff --git a/basis/ui/cocoa/views/views.factor b/basis/ui/cocoa/views/views.factor index 772770133d..a13d8f86df 100755 --- a/basis/ui/cocoa/views/views.factor +++ b/basis/ui/cocoa/views/views.factor @@ -329,7 +329,7 @@ CLASS: { [ 3drop 0 0 0 0 ] } -{ "conversationIdentifier" "long" { "id" "SEL" } +{ "conversationIdentifier" "NSInteger" { "id" "SEL" } [ drop alien-address ] } From 7eb6ceb08ca0261e130fe6c892d9e916caec6705 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Thu, 11 Sep 2008 21:35:52 -0700 Subject: [PATCH 4/9] typo --- basis/cocoa/types/types.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/cocoa/types/types.factor b/basis/cocoa/types/types.factor index d02865fe43..a76e74d9aa 100644 --- a/basis/cocoa/types/types.factor +++ b/basis/cocoa/types/types.factor @@ -77,7 +77,7 @@ TYPEDEF: NSRange _NSRange ! The "lL" type encodings refer to 32-bit values even in 64-bit mode TYPEDEF: int long32 -TYPEDEF: uint long32 +TYPEDEF: uint ulong32 TYPEDEF: void* unknown_type : ( length location -- size ) From f6ac828f4628babb638e309a6ca81fd674e5bca8 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 12 Sep 2008 20:01:07 -0700 Subject: [PATCH 5/9] yup, more type bugs --- basis/cocoa/messages/messages.factor | 2 +- basis/cocoa/subclassing/subclassing.factor | 10 +++++---- basis/ui/cocoa/views/views.factor | 26 +++++++++++----------- 3 files changed, 20 insertions(+), 18 deletions(-) diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index 93de7658ef..3ec42ee65d 100755 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -117,7 +117,7 @@ H{ { "*" "char*" } { "?" "unknown_type" } { "@" "id" } - { "#" "id" } + { "#" "Class" } { ":" "SEL" } } "ptrdiff_t" heap-size { diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor index 3f8e709df0..ec15c0b514 100755 --- a/basis/cocoa/subclassing/subclassing.factor +++ b/basis/cocoa/subclassing/subclassing.factor @@ -9,15 +9,17 @@ IN: cocoa.subclassing : init-method ( method -- sel imp types ) first3 swap - [ sel_registerName ] [ execute ] [ ascii string>alien ] - tri* ; + [ sel_registerName ] [ execute ] [ ascii string>alien ] ; + +: throw-if-false ( YES/NO -- ) + zero? [ "Failed to add method or protocol to class" throw ] when ; : add-methods ( methods class -- ) swap - [ init-method class_addMethod drop ] with each ; + [ init-method class_addMethod throw-if-false ] with each ; : add-protocols ( protocols class -- ) - swap [ objc-protocol class_addProtocol drop ] with each ; + swap [ objc-protocol class_addProtocol throw-if-false ] with each ; : (define-objc-class) ( protocols superclass name imeth -- ) -rot diff --git a/basis/ui/cocoa/views/views.factor b/basis/ui/cocoa/views/views.factor index a13d8f86df..c6942a8158 100755 --- a/basis/ui/cocoa/views/views.factor +++ b/basis/ui/cocoa/views/views.factor @@ -133,7 +133,7 @@ CLASS: { } ! Events -{ "acceptsFirstMouse:" "bool" { "id" "SEL" "id" } +{ "acceptsFirstMouse:" "char" { "id" "SEL" "id" } [ 3drop 1 ] } @@ -251,7 +251,7 @@ CLASS: { ! "rotateWithEvent:" "void" { "id" "SEL" "id" }} -{ "acceptsFirstResponder" "bool" { "id" "SEL" } +{ "acceptsFirstResponder" "char" { "id" "SEL" } [ 2drop 1 ] } @@ -264,26 +264,26 @@ CLASS: { ] } -{ "writeSelectionToPasteboard:types:" "bool" { "id" "SEL" "id" "id" } +{ "writeSelectionToPasteboard:types:" "char" { "id" "SEL" "id" "id" } [ CF>string-array NSStringPboardType swap member? [ >r drop window-focus gadget-selection dup [ - r> set-pasteboard-string t + r> set-pasteboard-string 1 ] [ - r> 2drop f + r> 2drop 0 ] if ] [ - 3drop f + 3drop 0 ] if ] } -{ "readSelectionFromPasteboard:" "bool" { "id" "SEL" "id" } +{ "readSelectionFromPasteboard:" "char" { "id" "SEL" "id" } [ pasteboard-string dup [ - >r drop window-focus r> swap user-input t + >r drop window-focus r> swap user-input 1 ] [ - 3drop f + 3drop 0 ] if ] } @@ -293,7 +293,7 @@ CLASS: { [ [ nip send-user-input ] ui-try ] } -{ "hasMarkedText" "bool" { "id" "SEL" } +{ "hasMarkedText" "char" { "id" "SEL" } [ 2drop 0 ] } @@ -321,7 +321,7 @@ CLASS: { [ 3drop f ] } -{ "characterIndexForPoint:" "uint" { "id" "SEL" "NSPoint" } +{ "characterIndexForPoint:" "NSUInteger" { "id" "SEL" "NSPoint" } [ 3drop 0 ] } @@ -394,9 +394,9 @@ CLASS: { ] } -{ "windowShouldClose:" "bool" { "id" "SEL" "id" } +{ "windowShouldClose:" "char" { "id" "SEL" "id" } [ - 3drop t + 3drop 1 ] } From 3e0ea36346f4b20e7ceaed1ade630da6a02baea0 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 12 Sep 2008 20:18:47 -0700 Subject: [PATCH 6/9] cleanup on aisle 5 --- basis/cocoa/subclassing/subclassing.factor | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor index ec15c0b514..fd18c7fa89 100755 --- a/basis/cocoa/subclassing/subclassing.factor +++ b/basis/cocoa/subclassing/subclassing.factor @@ -9,17 +9,20 @@ IN: cocoa.subclassing : init-method ( method -- sel imp types ) first3 swap - [ sel_registerName ] [ execute ] [ ascii string>alien ] ; + [ sel_registerName ] [ execute ] [ ascii string>alien ] + tri* ; : throw-if-false ( YES/NO -- ) - zero? [ "Failed to add method or protocol to class" throw ] when ; + zero? [ "Failed to add method or protocol to class" throw ] + when ; : add-methods ( methods class -- ) swap [ init-method class_addMethod throw-if-false ] with each ; : add-protocols ( protocols class -- ) - swap [ objc-protocol class_addProtocol throw-if-false ] with each ; + swap [ objc-protocol class_addProtocol throw-if-false ] + with each ; : (define-objc-class) ( protocols superclass name imeth -- ) -rot From a4210afd62befe77b98a39e2e3f107a080187376 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 13 Sep 2008 09:32:47 -0700 Subject: [PATCH 7/9] some debugging aids for cocoa libs --- basis/cocoa/messages/messages.factor | 21 ++++++++++++++++----- basis/cocoa/runtime/runtime.factor | 5 ++++- 2 files changed, 20 insertions(+), 6 deletions(-) diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index 3ec42ee65d..3d7e1bfd84 100755 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -3,7 +3,7 @@ USING: accessors alien alien.c-types alien.strings arrays assocs combinators compiler kernel math namespaces make parser prettyprint prettyprint.sections quotations sequences strings -words cocoa.runtime io macros memoize debugger +words cocoa.runtime io macros memoize debugger fry io.encodings.ascii effects compiler.generator libc libc.private ; IN: cocoa.messages @@ -201,12 +201,23 @@ assoc-union alien>objc-types set-global swap method_getName sel_getName objc-methods get set-at ; -: (register-objc-methods) ( methods count -- methods ) - over [ void*-nth register-objc-method ] curry each ; +: each-method-in-class ( class quot -- ) + [ 0 [ class_copyMethodList ] keep *uint over ] dip + '[ _ void*-nth @ ] each (free) ; inline : register-objc-methods ( class -- ) - 0 [ class_copyMethodList ] keep *uint - (register-objc-methods) (free) ; + [ register-objc-method ] each-method-in-class ; + +: method. ( method -- ) + { + [ method_getName sel_getName ] + [ method-return-type ] + [ method-arg-types ] + [ method_getImplementation ] + } cleave 4array . ; + +: methods. ( class -- ) + [ method. ] each-method-in-class ; : class-exists? ( string -- class ) objc_getClass >boolean ; diff --git a/basis/cocoa/runtime/runtime.factor b/basis/cocoa/runtime/runtime.factor index 3451ce5e6e..1a741b789f 100644 --- a/basis/cocoa/runtime/runtime.factor +++ b/basis/cocoa/runtime/runtime.factor @@ -9,7 +9,7 @@ TYPEDEF: void* id FUNCTION: char* sel_getName ( SEL aSelector ) ; -FUNCTION: bool sel_isMapped ( SEL aSelector ) ; +FUNCTION: char sel_isMapped ( SEL aSelector ) ; FUNCTION: SEL sel_registerName ( char* str ) ; @@ -54,6 +54,8 @@ FUNCTION: Method* class_copyMethodList ( Class class, uint* outCount ) ; FUNCTION: Class class_getSuperclass ( Class cls ) ; +FUNCTION: char* class_getName ( Class cls ) ; + FUNCTION: char class_addMethod ( Class class, SEL name, void* imp, void* types ) ; FUNCTION: char class_addProtocol ( Class class, Protocol protocol ) ; @@ -73,5 +75,6 @@ FUNCTION: void* method_getTypeEncoding ( Method method ) ; FUNCTION: SEL method_getName ( Method method ) ; FUNCTION: void* method_setImplementation ( Method method, void* imp ) ; +FUNCTION: void* method_getImplementation ( Method method ) ; FUNCTION: Class object_getClass ( id object ) ; From dacd2dfc1c51b3fc894fe28f24bd887c9aea1568 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Tue, 30 Sep 2008 18:42:32 -0700 Subject: [PATCH 8/9] add capability verification and fix shader param error in spheres --- extra/spheres/spheres.factor | 35 +++++++++++++++++++---------------- 1 file changed, 19 insertions(+), 16 deletions(-) diff --git a/extra/spheres/spheres.factor b/extra/spheres/spheres.factor index 84621f8e18..0b7f1f95bb 100755 --- a/extra/spheres/spheres.factor +++ b/extra/spheres/spheres.factor @@ -1,6 +1,6 @@ USING: kernel opengl.demo-support opengl.gl opengl.shaders opengl.framebuffers -opengl multiline ui.gadgets accessors sequences ui.render ui math -arrays generalizations combinators ; +opengl multiline ui.gadgets accessors sequences ui.render ui math locals +arrays generalizations combinators opengl.capabilities ; IN: spheres STRING: plane-vertex-shader @@ -162,6 +162,8 @@ M: spheres-gadget distance-step ( gadget -- dz ) 3array check-gl-program ; M: spheres-gadget graft* ( gadget -- ) + "2.0" { "GL_ARB_shader_objects" } require-gl-version-or-extensions + { "GL_EXT_framebuffer_object" } require-gl-extensions (plane-program) >>plane-program (solid-sphere-program) >>solid-sphere-program (texture-sphere-program) >>texture-sphere-program @@ -182,14 +184,15 @@ M: spheres-gadget ungraft* ( gadget -- ) M: spheres-gadget pref-dim* ( gadget -- dim ) drop { 640 480 } ; - -: (draw-sphere) ( program center radius surfacecolor -- ) - roll - [ [ "center" glGetAttribLocation swap first3 glVertexAttrib3f ] curry ] - [ [ "radius" glGetAttribLocation swap glVertexAttrib1f ] curry ] - [ [ "surface_color" glGetAttribLocation swap first4 glVertexAttrib4f ] curry ] - tri tri* + +:: (draw-sphere) ( program center radius -- ) + program "center" glGetAttribLocation center first3 glVertexAttrib3f + program "radius" glGetAttribLocation radius glVertexAttrib1f { -1.0 -1.0 } { 1.0 1.0 } rect-vertices ; + +:: (draw-colored-sphere) ( program center radius surfacecolor -- ) + program "surface_color" glGetAttribLocation surfacecolor first4 glVertexAttrib4f + program center radius (draw-sphere) ; : sphere-scene ( gadget -- ) GL_DEPTH_BUFFER_BIT GL_COLOR_BUFFER_BIT bitor glClear @@ -197,12 +200,12 @@ M: spheres-gadget pref-dim* ( gadget -- dim ) solid-sphere-program>> [ { [ "light_position" glGetUniformLocation 0.0 0.0 100.0 glUniform3f ] - [ { 7.0 0.0 0.0 } 1.0 { 1.0 0.0 0.0 1.0 } (draw-sphere) ] - [ { -7.0 0.0 0.0 } 1.0 { 0.0 1.0 0.0 1.0 } (draw-sphere) ] - [ { 0.0 0.0 7.0 } 1.0 { 0.0 0.0 1.0 1.0 } (draw-sphere) ] - [ { 0.0 0.0 -7.0 } 1.0 { 1.0 1.0 0.0 1.0 } (draw-sphere) ] - [ { 0.0 7.0 0.0 } 1.0 { 1.0 0.0 1.0 1.0 } (draw-sphere) ] - [ { 0.0 -7.0 0.0 } 1.0 { 0.0 1.0 1.0 1.0 } (draw-sphere) ] + [ { 7.0 0.0 0.0 } 1.0 { 1.0 0.0 0.0 1.0 } (draw-colored-sphere) ] + [ { -7.0 0.0 0.0 } 1.0 { 0.0 1.0 0.0 1.0 } (draw-colored-sphere) ] + [ { 0.0 0.0 7.0 } 1.0 { 0.0 0.0 1.0 1.0 } (draw-colored-sphere) ] + [ { 0.0 0.0 -7.0 } 1.0 { 1.0 1.0 0.0 1.0 } (draw-colored-sphere) ] + [ { 0.0 7.0 0.0 } 1.0 { 1.0 0.0 1.0 1.0 } (draw-colored-sphere) ] + [ { 0.0 -7.0 0.0 } 1.0 { 0.0 1.0 1.0 1.0 } (draw-colored-sphere) ] } cleave ] with-gl-program ] [ @@ -271,7 +274,7 @@ M: spheres-gadget draw-gadget* ( gadget -- ) [ texture-sphere-program>> [ [ "surface_texture" glGetUniformLocation 0 glUniform1i ] - [ { 0.0 0.0 0.0 } 4.0 { 1.0 0.0 0.0 1.0 } (draw-sphere) ] + [ { 0.0 0.0 0.0 } 4.0 (draw-sphere) ] bi ] with-gl-program ] From 3399a579d03f412cf57627aed56f0c195a2d1d4a Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Sat, 4 Oct 2008 16:33:51 -0700 Subject: [PATCH 9/9] call find-gl-context to ensure context is set during graft/ungraft in GL demos --- extra/bunny/bunny.factor | 5 ++++- extra/spheres/spheres.factor | 4 +++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/extra/bunny/bunny.factor b/extra/bunny/bunny.factor index ed89f2a809..d0625e464f 100755 --- a/extra/bunny/bunny.factor +++ b/extra/bunny/bunny.factor @@ -1,6 +1,7 @@ USING: accessors arrays bunny.cel-shaded bunny.fixed-pipeline bunny.model bunny.outlined destructors kernel math opengl.demo-support -opengl.gl sequences ui ui.gadgets ui.gestures ui.render words ; +opengl.gl sequences ui ui.gadgets ui.gadgets.worlds ui.gestures +ui.render words ; IN: bunny TUPLE: bunny-gadget < demo-gadget model-triangles geom draw-seq draw-n ; @@ -18,6 +19,7 @@ TUPLE: bunny-gadget < demo-gadget model-triangles geom draw-seq draw-n ; >>draw-n relayout-1 ; M: bunny-gadget graft* ( gadget -- ) + dup find-gl-context GL_DEPTH_TEST glEnable dup model-triangles>> >>geom dup @@ -29,6 +31,7 @@ M: bunny-gadget graft* ( gadget -- ) drop ; M: bunny-gadget ungraft* ( gadget -- ) + dup find-gl-context [ geom>> [ dispose ] when* ] [ draw-seq>> [ [ dispose ] when* ] each ] bi ; diff --git a/extra/spheres/spheres.factor b/extra/spheres/spheres.factor index 0b7f1f95bb..f119956db6 100755 --- a/extra/spheres/spheres.factor +++ b/extra/spheres/spheres.factor @@ -1,6 +1,6 @@ USING: kernel opengl.demo-support opengl.gl opengl.shaders opengl.framebuffers opengl multiline ui.gadgets accessors sequences ui.render ui math locals -arrays generalizations combinators opengl.capabilities ; +arrays generalizations combinators opengl.capabilities ui.gadgets.worlds ; IN: spheres STRING: plane-vertex-shader @@ -162,6 +162,7 @@ M: spheres-gadget distance-step ( gadget -- dz ) 3array check-gl-program ; M: spheres-gadget graft* ( gadget -- ) + dup find-gl-context "2.0" { "GL_ARB_shader_objects" } require-gl-version-or-extensions { "GL_EXT_framebuffer_object" } require-gl-extensions (plane-program) >>plane-program @@ -173,6 +174,7 @@ M: spheres-gadget graft* ( gadget -- ) drop ; M: spheres-gadget ungraft* ( gadget -- ) + dup find-gl-context { [ reflection-framebuffer>> [ delete-framebuffer ] when* ] [ reflection-depthbuffer>> [ delete-renderbuffer ] when* ]