Merge branch 'master' of git://factorcode.org/git/factor
Doug Coleman
commit
f4d8a61461
|
|
@ -49,12 +49,11 @@ HELP: c-setter
|
|||
{ $errors "Throws an error if the type does not exist." } ;
|
||||
|
||||
HELP: <c-array>
|
||||
{ $deprecated "New code should use " { $link <c-type-array> } " or the " { $vocab-link "specialized-arrays" } " vocabularies." }
|
||||
{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "array" byte-array } }
|
||||
{ $description "Creates a byte array large enough to hold " { $snippet "n" } " values of a C type." }
|
||||
{ $errors "Throws an error if the type does not exist or the requested size is negative." } ;
|
||||
|
||||
{ <c-array> malloc-array } related-words
|
||||
|
||||
HELP: <c-object>
|
||||
{ $values { "type" "a C type" } { "array" byte-array } }
|
||||
{ $description "Creates a byte array suitable for holding a value with the given C type." }
|
||||
|
|
@ -73,9 +72,10 @@ HELP: byte-array>memory
|
|||
|
||||
HELP: malloc-array
|
||||
{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "alien" alien } }
|
||||
{ $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type." }
|
||||
{ $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type, then wraps the memory in a sequence object using " { $link <c-type-direct-array> } "." }
|
||||
{ $notes "The appropriate direct specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-type-arrays } " word. See the " { $vocab-link "specialized-arrays.direct" } " vocabulary set for details on the underlying sequence type constructed." }
|
||||
{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
|
||||
{ $errors "Throws an error if the type does not exist, if the requested size is negative, or if memory allocation fails." } ;
|
||||
{ $errors "Throws an error if the type does not exist, if the requested size is negative, if a direct specialized array class appropriate to the type is not loaded, or if memory allocation fails." } ;
|
||||
|
||||
HELP: malloc-object
|
||||
{ $values { "type" "a C type" } { "alien" alien } }
|
||||
|
|
@ -89,6 +89,8 @@ HELP: malloc-byte-array
|
|||
{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
|
||||
{ $errors "Throws an error if memory allocation fails." } ;
|
||||
|
||||
{ <c-type-array> <c-type-direct-array> malloc-array } related-words
|
||||
|
||||
HELP: box-parameter
|
||||
{ $values { "n" integer } { "ctype" string } }
|
||||
{ $description "Generates code for converting a C value stored at offset " { $snippet "n" } " from the top of the stack into a Factor object to be pushed on the data stack." }
|
||||
|
|
|
|||
|
|
@ -254,16 +254,19 @@ M: f byte-length drop 0 ; inline
|
|||
] unless* ;
|
||||
|
||||
: <c-array> ( n type -- array )
|
||||
heap-size * <byte-array> ; inline
|
||||
heap-size * <byte-array> ; inline deprecated
|
||||
|
||||
: <c-object> ( type -- array )
|
||||
1 swap <c-array> ; inline
|
||||
heap-size <byte-array> ; inline
|
||||
|
||||
: (c-object) ( type -- array )
|
||||
heap-size (byte-array) ; inline
|
||||
|
||||
: malloc-array ( n type -- alien )
|
||||
heap-size calloc ; inline
|
||||
[ heap-size calloc ] [ <c-type-direct-array> ] 2bi ; inline
|
||||
|
||||
: malloc-object ( type -- alien )
|
||||
1 swap malloc-array ; inline
|
||||
heap-size malloc ; inline
|
||||
|
||||
: malloc-byte-array ( byte-array -- alien )
|
||||
dup byte-length [ nip malloc dup ] 2keep memcpy ;
|
||||
|
|
|
|||
|
|
@ -1,27 +1,28 @@
|
|||
! Copyright (C) 2008 Joe Groff.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel cocoa cocoa.types alien.c-types locals math
|
||||
sequences vectors fry libc destructors
|
||||
specialized-arrays.direct.alien ;
|
||||
USING: accessors kernel classes.struct cocoa cocoa.types alien.c-types
|
||||
locals math sequences vectors fry libc destructors ;
|
||||
IN: cocoa.enumeration
|
||||
|
||||
<< "id" require-c-type-arrays >>
|
||||
|
||||
CONSTANT: NS-EACH-BUFFER-SIZE 16
|
||||
|
||||
: with-enumeration-buffers ( quot -- )
|
||||
'[
|
||||
"NSFastEnumerationState" malloc-object &free
|
||||
NSFastEnumerationState malloc-struct &free
|
||||
NS-EACH-BUFFER-SIZE "id" malloc-array &free
|
||||
NS-EACH-BUFFER-SIZE
|
||||
@
|
||||
] with-destructors ; inline
|
||||
|
||||
:: (NSFastEnumeration-each) ( object quot: ( elt -- ) state stackbuf count -- )
|
||||
object state stackbuf count -> countByEnumeratingWithState:objects:count:
|
||||
dup 0 = [ drop ] [
|
||||
state NSFastEnumerationState-itemsPtr [ stackbuf ] unless*
|
||||
swap <direct-void*-array> quot each
|
||||
object state stackbuf count -> countByEnumeratingWithState:objects:count: :> items-count
|
||||
items-count 0 = [
|
||||
state itemsPtr>> [ items-count "id" <c-type-direct-array> ] [ stackbuf ] if* :> items
|
||||
items-count iota [ items nth quot call ] each
|
||||
object quot state stackbuf count (NSFastEnumeration-each)
|
||||
] if ; inline recursive
|
||||
] unless ; inline recursive
|
||||
|
||||
: NSFastEnumeration-each ( object quot -- )
|
||||
[ (NSFastEnumeration-each) ] with-enumeration-buffers ; inline
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien alien.c-types alien.strings arrays assocs
|
||||
continuations combinators compiler compiler.alien stack-checker kernel
|
||||
math namespaces make quotations sequences strings words
|
||||
cocoa.runtime io macros memoize io.encodings.utf8 effects libc
|
||||
libc.private lexer init core-foundation fry generalizations
|
||||
specialized-arrays.direct.alien ;
|
||||
classes.struct continuations combinators compiler compiler.alien
|
||||
stack-checker kernel math namespaces make quotations sequences
|
||||
strings words cocoa.runtime io macros memoize io.encodings.utf8
|
||||
effects libc libc.private lexer init core-foundation fry
|
||||
generalizations specialized-arrays.direct.alien ;
|
||||
IN: cocoa.messages
|
||||
|
||||
: make-sender ( method function -- quot )
|
||||
|
|
@ -31,11 +31,8 @@ super-message-senders [ H{ } clone ] initialize
|
|||
bi ;
|
||||
|
||||
: <super> ( receiver -- super )
|
||||
"objc-super" <c-object> [
|
||||
[ dup object_getClass class_getSuperclass ] dip
|
||||
set-objc-super-class
|
||||
] keep
|
||||
[ set-objc-super-receiver ] keep ;
|
||||
[ ] [ object_getClass class_getSuperclass ] bi
|
||||
objc-super <struct-boa> ;
|
||||
|
||||
TUPLE: selector name object ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2006, 2007 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.syntax ;
|
||||
USING: alien.syntax classes.struct ;
|
||||
IN: cocoa.runtime
|
||||
|
||||
TYPEDEF: void* SEL
|
||||
|
|
@ -17,9 +17,9 @@ TYPEDEF: void* Class
|
|||
TYPEDEF: void* Method
|
||||
TYPEDEF: void* Protocol
|
||||
|
||||
C-STRUCT: objc-super
|
||||
{ "id" "receiver" }
|
||||
{ "Class" "class" } ;
|
||||
STRUCT: objc-super
|
||||
{ receiver id }
|
||||
{ class Class } ;
|
||||
|
||||
CONSTANT: CLS_CLASS HEX: 1
|
||||
CONSTANT: CLS_META HEX: 2
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2006, 2009 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types alien.syntax combinators kernel layouts
|
||||
core-graphics.types ;
|
||||
classes.struct core-graphics.types ;
|
||||
IN: cocoa.types
|
||||
|
||||
TYPEDEF: long NSInteger
|
||||
|
|
@ -16,9 +16,9 @@ TYPEDEF: NSSize _NSSize
|
|||
TYPEDEF: CGRect NSRect
|
||||
TYPEDEF: NSRect _NSRect
|
||||
|
||||
C-STRUCT: NSRange
|
||||
{ "NSUInteger" "location" }
|
||||
{ "NSUInteger" "length" } ;
|
||||
STRUCT: NSRange
|
||||
{ location NSUInteger }
|
||||
{ length NSUInteger } ;
|
||||
|
||||
TYPEDEF: NSRange _NSRange
|
||||
|
||||
|
|
@ -27,13 +27,11 @@ TYPEDEF: int long32
|
|||
TYPEDEF: uint ulong32
|
||||
TYPEDEF: void* unknown_type
|
||||
|
||||
: <NSRange> ( length location -- size )
|
||||
"NSRange" <c-object>
|
||||
[ set-NSRange-length ] keep
|
||||
[ set-NSRange-location ] keep ;
|
||||
: <NSRange> ( location length -- size )
|
||||
NSRange <struct-boa> ;
|
||||
|
||||
C-STRUCT: NSFastEnumerationState
|
||||
{ "ulong" "state" }
|
||||
{ "id*" "itemsPtr" }
|
||||
{ "ulong*" "mutationsPtr" }
|
||||
{ "ulong[5]" "extra" } ;
|
||||
STRUCT: NSFastEnumerationState
|
||||
{ state ulong }
|
||||
{ itemsPtr id* }
|
||||
{ mutationsPtr ulong* }
|
||||
{ extra ulong[5] } ;
|
||||
|
|
|
|||
|
|
@ -58,6 +58,6 @@ CONSTANT: NSOpenGLCPSwapInterval 222
|
|||
: mouse-location ( view event -- loc )
|
||||
[
|
||||
-> locationInWindow f -> convertPoint:fromView:
|
||||
[ CGPoint-x ] [ CGPoint-y ] bi
|
||||
[ x>> ] [ y>> ] bi
|
||||
] [ drop -> frame CGRect-h ] 2bi
|
||||
swap - [ >integer ] bi@ 2array ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.syntax alien.c-types alien.destructors accessors kernel ;
|
||||
USING: alien.syntax alien.c-types alien.destructors accessors classes.struct kernel ;
|
||||
IN: core-foundation
|
||||
|
||||
TYPEDEF: void* CFTypeRef
|
||||
|
|
@ -20,17 +20,15 @@ TYPEDEF: void* CFUUIDRef
|
|||
ALIAS: <CFIndex> <long>
|
||||
ALIAS: *CFIndex *long
|
||||
|
||||
C-STRUCT: CFRange
|
||||
{ "CFIndex" "location" }
|
||||
{ "CFIndex" "length" } ;
|
||||
STRUCT: CFRange
|
||||
{ location CFIndex }
|
||||
{ length CFIndex } ;
|
||||
|
||||
: <CFRange> ( location length -- range )
|
||||
"CFRange" <c-object>
|
||||
[ set-CFRange-length ] keep
|
||||
[ set-CFRange-location ] keep ;
|
||||
CFRange <struct-boa> ;
|
||||
|
||||
FUNCTION: CFTypeRef CFRetain ( CFTypeRef cf ) ;
|
||||
|
||||
FUNCTION: void CFRelease ( CFTypeRef cf ) ;
|
||||
|
||||
DESTRUCTOR: CFRelease
|
||||
DESTRUCTOR: CFRelease
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: alien alien.c-types alien.strings alien.syntax kernel
|
||||
math sequences namespaces make assocs init accessors
|
||||
continuations combinators io.encodings.utf8 destructors locals
|
||||
arrays specialized-arrays.direct.alien
|
||||
arrays specialized-arrays.direct.alien classes.struct
|
||||
specialized-arrays.direct.int specialized-arrays.direct.longlong
|
||||
core-foundation core-foundation.run-loop core-foundation.strings
|
||||
core-foundation.time ;
|
||||
|
|
@ -26,12 +26,12 @@ TYPEDEF: int FSEventStreamEventFlags
|
|||
TYPEDEF: longlong FSEventStreamEventId
|
||||
TYPEDEF: void* FSEventStreamRef
|
||||
|
||||
C-STRUCT: FSEventStreamContext
|
||||
{ "CFIndex" "version" }
|
||||
{ "void*" "info" }
|
||||
{ "void*" "retain" }
|
||||
{ "void*" "release" }
|
||||
{ "void*" "copyDescription" } ;
|
||||
STRUCT: FSEventStreamContext
|
||||
{ version CFIndex }
|
||||
{ info void* }
|
||||
{ retain void* }
|
||||
{ release void* }
|
||||
{ copyDescription void* } ;
|
||||
|
||||
! callback(FSEventStreamRef streamRef, void *clientCallBackInfo, size_t numEvents, void *eventPaths, const FSEventStreamEventFlags eventFlags[], const FSEventStreamEventId eventIds[]);
|
||||
TYPEDEF: void* FSEventStreamCallback
|
||||
|
|
@ -104,8 +104,8 @@ FUNCTION: void FSEventStreamShow ( FSEventStreamRef streamRef ) ;
|
|||
FUNCTION: CFStringRef FSEventStreamCopyDescription ( FSEventStreamRef streamRef ) ;
|
||||
|
||||
: make-FSEventStreamContext ( info -- alien )
|
||||
"FSEventStreamContext" <c-object>
|
||||
[ set-FSEventStreamContext-info ] keep ;
|
||||
FSEventStreamContext <struct>
|
||||
swap >>info ;
|
||||
|
||||
:: <FSEventStream> ( callback info paths latency flags -- event-stream )
|
||||
f ! allocator
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types alien.syntax kernel layouts
|
||||
USING: accessors alien.c-types alien.syntax classes.struct kernel layouts
|
||||
math math.rectangles arrays ;
|
||||
IN: core-graphics.types
|
||||
|
||||
|
|
@ -12,63 +12,56 @@ IN: core-graphics.types
|
|||
: *CGFloat ( alien -- x )
|
||||
cell 4 = [ *float ] [ *double ] if ; inline
|
||||
|
||||
C-STRUCT: CGPoint
|
||||
{ "CGFloat" "x" }
|
||||
{ "CGFloat" "y" } ;
|
||||
STRUCT: CGPoint
|
||||
{ x CGFloat }
|
||||
{ y CGFloat } ;
|
||||
|
||||
: <CGPoint> ( x y -- point )
|
||||
"CGPoint" <c-object>
|
||||
[ set-CGPoint-y ] keep
|
||||
[ set-CGPoint-x ] keep ;
|
||||
CGPoint <struct-boa> ;
|
||||
|
||||
C-STRUCT: CGSize
|
||||
{ "CGFloat" "w" }
|
||||
{ "CGFloat" "h" } ;
|
||||
STRUCT: CGSize
|
||||
{ w CGFloat }
|
||||
{ h CGFloat } ;
|
||||
|
||||
: <CGSize> ( w h -- size )
|
||||
"CGSize" <c-object>
|
||||
[ set-CGSize-h ] keep
|
||||
[ set-CGSize-w ] keep ;
|
||||
CGSize <struct-boa> ;
|
||||
|
||||
C-STRUCT: CGRect
|
||||
{ "CGPoint" "origin" }
|
||||
{ "CGSize" "size" } ;
|
||||
STRUCT: CGRect
|
||||
{ origin CGPoint }
|
||||
{ size CGSize } ;
|
||||
|
||||
: CGPoint>loc ( CGPoint -- loc )
|
||||
[ CGPoint-x ] [ CGPoint-y ] bi 2array ;
|
||||
[ x>> ] [ y>> ] bi 2array ;
|
||||
|
||||
: CGSize>dim ( CGSize -- dim )
|
||||
[ CGSize-w ] [ CGSize-h ] bi 2array ;
|
||||
[ w>> ] [ h>> ] bi 2array ;
|
||||
|
||||
: CGRect>rect ( CGRect -- rect )
|
||||
[ CGRect-origin CGPoint>loc ]
|
||||
[ CGRect-size CGSize>dim ]
|
||||
[ origin>> CGPoint>loc ]
|
||||
[ size>> CGSize>dim ]
|
||||
bi <rect> ; inline
|
||||
|
||||
: CGRect-x ( CGRect -- x )
|
||||
CGRect-origin CGPoint-x ; inline
|
||||
origin>> x>> ; inline
|
||||
: CGRect-y ( CGRect -- y )
|
||||
CGRect-origin CGPoint-y ; inline
|
||||
origin>> y>> ; inline
|
||||
: CGRect-w ( CGRect -- w )
|
||||
CGRect-size CGSize-w ; inline
|
||||
size>> w>> ; inline
|
||||
: CGRect-h ( CGRect -- h )
|
||||
CGRect-size CGSize-h ; inline
|
||||
size>> h>> ; inline
|
||||
|
||||
: set-CGRect-x ( x CGRect -- )
|
||||
CGRect-origin set-CGPoint-x ; inline
|
||||
origin>> (>>x) ; inline
|
||||
: set-CGRect-y ( y CGRect -- )
|
||||
CGRect-origin set-CGPoint-y ; inline
|
||||
origin>> (>>y) ; inline
|
||||
: set-CGRect-w ( w CGRect -- )
|
||||
CGRect-size set-CGSize-w ; inline
|
||||
size>> (>>w) ; inline
|
||||
: set-CGRect-h ( h CGRect -- )
|
||||
CGRect-size set-CGSize-h ; inline
|
||||
size>> (>>h) ; inline
|
||||
|
||||
: <CGRect> ( x y w h -- rect )
|
||||
"CGRect" <c-object>
|
||||
[ set-CGRect-h ] keep
|
||||
[ set-CGRect-w ] keep
|
||||
[ set-CGRect-y ] keep
|
||||
[ set-CGRect-x ] keep ;
|
||||
[ CGPoint <struct-boa> ] [ CGSize <struct-boa> ] 2bi*
|
||||
CGRect <struct-boa> ;
|
||||
|
||||
: CGRect-x-y ( alien -- origin-x origin-y )
|
||||
[ CGRect-x ] [ CGRect-y ] bi ;
|
||||
|
|
@ -76,13 +69,13 @@ C-STRUCT: CGRect
|
|||
: CGRect-top-left ( alien -- x y )
|
||||
[ CGRect-x ] [ [ CGRect-y ] [ CGRect-h ] bi + ] bi ;
|
||||
|
||||
C-STRUCT: CGAffineTransform
|
||||
{ "CGFloat" "a" }
|
||||
{ "CGFloat" "b" }
|
||||
{ "CGFloat" "c" }
|
||||
{ "CGFloat" "d" }
|
||||
{ "CGFloat" "tx" }
|
||||
{ "CGFloat" "ty" } ;
|
||||
STRUCT: CGAffineTransform
|
||||
{ a CGFloat }
|
||||
{ b CGFloat }
|
||||
{ c CGFloat }
|
||||
{ d CGFloat }
|
||||
{ tx CGFloat }
|
||||
{ ty CGFloat } ;
|
||||
|
||||
TYPEDEF: void* CGColorRef
|
||||
TYPEDEF: void* CGColorSpaceRef
|
||||
|
|
|
|||
|
|
@ -116,8 +116,8 @@ TUPLE: line < disposable line metrics image loc dim ;
|
|||
line [ string open-font font foreground>> <CTLine> |CFRelease ]
|
||||
|
||||
rect [ line line-rect ]
|
||||
(loc) [ rect CGRect-origin CGPoint>loc ]
|
||||
(dim) [ rect CGRect-size CGSize>dim ]
|
||||
(loc) [ rect origin>> CGPoint>loc ]
|
||||
(dim) [ rect size>> CGSize>dim ]
|
||||
(ext) [ (loc) (dim) v+ ]
|
||||
loc [ (loc) [ floor ] map ]
|
||||
ext [ (loc) (dim) [ + ceiling ] 2map ]
|
||||
|
|
|
|||
|
|
@ -13,6 +13,9 @@ M: bad-byte-array-length summary
|
|||
: (c-array) ( n c-type -- array )
|
||||
heap-size * (byte-array) ; inline
|
||||
|
||||
: <c-array> ( n type -- array )
|
||||
heap-size * <byte-array> ; inline
|
||||
|
||||
FUNCTOR: define-array ( T -- )
|
||||
|
||||
A DEFINES-CLASS ${T}-array
|
||||
|
|
|
|||
|
|
@ -98,9 +98,9 @@ M: f like drop [ f ] when-empty ; inline
|
|||
|
||||
INSTANCE: f immutable-sequence
|
||||
|
||||
! Integers support the sequence protocol
|
||||
M: integer length ; inline
|
||||
M: integer nth-unsafe drop ; inline
|
||||
! Integers used to support the sequence protocol
|
||||
M: integer length ; inline deprecated
|
||||
M: integer nth-unsafe drop ; inline deprecated
|
||||
|
||||
INSTANCE: integer immutable-sequence
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue