Merge branch 'master' of git://repo.or.cz/factor/jcg
Conflicts: basis/cocoa/messages/messages.factordb4
commit
171c235c96
basis
cocoa
ui/cocoa/views
extra
bunny
spheres
|
@ -3,9 +3,8 @@
|
|||
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 )
|
||||
|
@ -108,22 +107,34 @@ H{
|
|||
{ "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
|
||||
|
@ -132,16 +143,22 @@ objc>alien-types get [ swap ] assoc-map
|
|||
! 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
|
||||
|
@ -184,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 <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 ;
|
||||
|
||||
|
|
|
@ -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 ) ;
|
||||
|
|
|
@ -12,12 +12,17 @@ IN: cocoa.subclassing
|
|||
[ 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
|
||||
|
|
|
@ -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
|
||||
|
||||
: <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" } ;
|
||||
|
@ -47,19 +28,58 @@ C-STRUCT: NSSize
|
|||
|
||||
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
|
||||
|
|
|
@ -128,12 +128,12 @@ CLASS: {
|
|||
}
|
||||
|
||||
! 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 ]
|
||||
}
|
||||
|
||||
|
@ -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 ]
|
||||
}
|
||||
|
||||
|
@ -329,7 +329,7 @@ CLASS: {
|
|||
[ 3drop 0 0 0 0 <NSRect> ]
|
||||
}
|
||||
|
||||
{ "conversationIdentifier" "long" { "id" "SEL" }
|
||||
{ "conversationIdentifier" "NSInteger" { "id" "SEL" }
|
||||
[ drop alien-address ]
|
||||
}
|
||||
|
||||
|
@ -394,9 +394,9 @@ CLASS: {
|
|||
]
|
||||
}
|
||||
|
||||
{ "windowShouldClose:" "bool" { "id" "SEL" "id" }
|
||||
{ "windowShouldClose:" "char" { "id" "SEL" "id" }
|
||||
[
|
||||
3drop t
|
||||
3drop 1
|
||||
]
|
||||
}
|
||||
|
||||
|
|
|
@ -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>> <bunny-geom> >>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 ;
|
||||
|
||||
|
|
|
@ -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 ui.gadgets.worlds ;
|
||||
IN: spheres
|
||||
|
||||
STRING: plane-vertex-shader
|
||||
|
@ -162,6 +162,9 @@ M: spheres-gadget distance-step ( gadget -- dz )
|
|||
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
|
||||
|
@ -171,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* ]
|
||||
|
@ -182,14 +186,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 +202,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 +276,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
|
||||
]
|
||||
|
|
Loading…
Reference in New Issue