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
-io.encodings.ascii effects compiler.generator libc libc.private
-parser lexer init core-foundation ;
+words cocoa.runtime io macros memoize debugger fry
+io.encodings.ascii effects compiler.generator libc libc.private ;
IN: cocoa.messages
: make-sender ( method function -- quot )
{ "c" "char" }
{ "i" "int" }
{ "s" "short" }
- { "l" "long" }
- { "q" "longlong" }
{ "C" "uchar" }
{ "I" "uint" }
{ "S" "ushort" }
- { "L" "ulong" }
- { "Q" "ulonglong" }
{ "f" "float" }
{ "d" "double" }
{ "B" "bool" }
{ "v" "void" }
{ "*" "char*" }
+ { "?" "unknown_type" }
{ "@" "id" }
- { "#" "id" }
+ { "#" "Class" }
{ ":" "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
! A hack...
"ptrdiff_t" heap-size {
{ 4 [ H{
- { "NSPoint" "{_NSPoint=ff}" }
- { "NSRect" "{_NSRect=ffff}" }
- { "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" "{_NSPoint=dd}" }
- { "NSRect" "{_NSRect=dddd}" }
- { "NSSize" "{_NSSize=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
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 <uint> [ class_copyMethodList ] keep *uint over ] dip
+ '[ _ void*-nth @ ] each (free) ; inline
: register-objc-methods ( class -- )
- 0 <uint> [ 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 ;
FUNCTION: char* sel_getName ( SEL aSelector ) ;
-FUNCTION: bool sel_isMapped ( SEL aSelector ) ;
+FUNCTION: char sel_isMapped ( SEL aSelector ) ;
FUNCTION: SEL sel_registerName ( char* str ) ;
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 ) ;
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 ) ;
[ sel_registerName ] [ execute ] [ ascii string>alien ]
tri* ;
+: 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
{ 8 [ "double" ] }
} case "CGFloat" typedef >>
-C-STRUCT: NSRect
- { "CGFloat" "x" }
- { "CGFloat" "y" }
- { "CGFloat" "w" }
- { "CGFloat" "h" } ;
-
-TYPEDEF: NSRect _NSRect
-TYPEDEF: NSRect CGRect
-
-: <NSRect> ( x y w h -- rect )
- "NSRect" <c-object>
- [ 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" } ;
TYPEDEF: NSSize _NSSize
TYPEDEF: NSSize CGSize
-TYPEDEF: NSPoint CGPoint
: <NSSize> ( w h -- size )
"NSSize" <c-object>
[ 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
+
+: <NSRect> ( x y w h -- rect )
+ "NSRect" <c-object>
+ [ 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" } ;
TYPEDEF: NSRange _NSRange
+! The "lL" type encodings refer to 32-bit values even in 64-bit mode
+TYPEDEF: int long32
+TYPEDEF: uint ulong32
+TYPEDEF: void* unknown_type
+
: <NSRange> ( length location -- size )
"NSRange" <c-object>
[ set-NSRange-length ] keep
}
! Rendering
-{ "drawRect:" "void" { "id" "SEL" "id" "NSRect" }
- [ 3drop window relayout-1 ]
+{ "drawRect:" "void" { "id" "SEL" "NSRect" }
+ [ 2drop window relayout-1 ]
}
! Events
-{ "acceptsFirstMouse:" "bool" { "id" "SEL" "id" }
+{ "acceptsFirstMouse:" "char" { "id" "SEL" "id" }
[ 3drop 1 ]
}
! "rotateWithEvent:" "void" { "id" "SEL" "id" }}
-{ "acceptsFirstResponder" "bool" { "id" "SEL" }
+{ "acceptsFirstResponder" "char" { "id" "SEL" }
[ 2drop 1 ]
}
]
}
-{ "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
]
}
[ [ nip send-user-input ] ui-try ]
}
-{ "hasMarkedText" "bool" { "id" "SEL" }
+{ "hasMarkedText" "char" { "id" "SEL" }
[ 2drop 0 ]
}
[ 3drop f ]
}
-{ "characterIndexForPoint:" "uint" { "id" "SEL" "NSPoint" }
+{ "characterIndexForPoint:" "NSUInteger" { "id" "SEL" "NSPoint" }
[ 3drop 0 ]
}
[ 3drop 0 0 0 0 <NSRect> ]
}
-{ "conversationIdentifier" "long" { "id" "SEL" }
+{ "conversationIdentifier" "NSInteger" { "id" "SEL" }
[ drop alien-address ]
}
]
}
-{ "windowShouldClose:" "bool" { "id" "SEL" "id" }
+{ "windowShouldClose:" "char" { "id" "SEL" "id" }
[
- 3drop t
+ 3drop 1
]
}
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 ;
>>draw-n relayout-1 ;
M: bunny-gadget graft* ( gadget -- )
+ dup find-gl-context
GL_DEPTH_TEST glEnable
dup model-triangles>> <bunny-geom> >>geom
dup
drop ;
M: bunny-gadget ungraft* ( gadget -- )
+ dup find-gl-context
[ geom>> [ dispose ] when* ]
[ draw-seq>> [ [ dispose ] when* ] each ] bi ;
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 ui.gadgets.worlds ;
IN: spheres
STRING: plane-vertex-shader
3array <gl-program> 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
(solid-sphere-program) >>solid-sphere-program
(texture-sphere-program) >>texture-sphere-program
drop ;
M: spheres-gadget ungraft* ( gadget -- )
+ dup find-gl-context
{
[ reflection-framebuffer>> [ delete-framebuffer ] when* ]
[ reflection-depthbuffer>> [ delete-renderbuffer ] when* ]
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
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
] [
[
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
]
projects / factor.git / commitdiff