steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add generation of records as STRUCT: with slots when the record is listed in IMPLEMENT-STRUCTS:, add generation of enumerations as ENUM:

db4
Anton Gorenko 2010-05-11 23:31:35 +06:00
parent b2b5365ebd
commit e97f10ff6b
15 changed files with 105 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
basis/gdk/gdk.factor
View File

@ -1,12 +1,29 @@
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax cairo.ffi
USING: alien.syntax alien.libraries cairo.ffi
combinators kernel system
gir glib gobject gio gmodule gdk.pixbuf glib.ffi ;
EXCLUDE: alien.c-types => pointer ;
<<
"gdk" {
{ [ os winnt? ] [ "libgdk-win32-2.0-0.dll" "cdecl" add-library ] }
{ [ os macosx? ] [ drop ] }
{ [ os unix? ] [ "libgdk-x11-2.0.so" "cdecl" add-library ] }
} cond
>>
IN: gdk.ffi
TYPEDEF: guint32 GdkNativeWindow
TYPEDEF: guint32 GdkWChar
IMPLEMENT-STRUCTS: GdkEventAny GdkEventKey GdkEventButton
GdkEventScroll GdkEventMotion GdkEventExpose GdkEventVisibility
GdkEventCrossing GdkEventFocus GdkEventConfigure GdkEventProperty
GdkEventSelection GdkEventDND GdkEventProximity GdkEventClient
GdkEventNoExpose GdkEventWindowState GdkEventSetting
GdkEventOwnerChange GdkEventGrabBroken ;
IN-GIR: gdk vocab:gdk/Gdk-2.0.gir

1
basis/gdk/pixbuf/pixbuf.factor
View File

@ -1,6 +1,7 @@
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: gir glib gobject gio gmodule ;
EXCLUDE: alien.c-types => pointer ;
IN-GIR: gdk.pixbuf vocab:gdk/pixbuf/GdkPixbuf-2.0.gir

1
basis/gio/gio.factor
View File

@ -1,6 +1,7 @@
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: gir glib gobject ;
EXCLUDE: alien.c-types => pointer ;
IN-GIR: gio vocab:gio/Gio-2.0.gir

2
basis/gir/common/common.factor
View File

@ -16,5 +16,7 @@ type-infos [ H{ } ] initialize
SYMBOL: aliases
aliases [ H{ } ] initialize
SYMBOL: implement-structs
: get-lib-alias ( lib -- alias )
lib-aliases get-global at ;

49
basis/gir/ffi/ffi.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.parser assocs combinators
combinators.short-circuit effects fry generalizations
USING: accessors alien alien.c-types alien.enums alien.parser arrays assocs classes.parser
classes.struct combinators combinators.short-circuit compiler.units effects definitions fry generalizations
gir.common gir.types kernel locals math math.parser namespaces
parser prettyprint quotations sequences vocabs.parser words
words.constant ;
@ -52,10 +52,10 @@ IN: gir.ffi
: signal-ffi-effect ( signal -- effect )
[ parameters>> [ name>> ] map ]
[ return>> type>> none-type? { } { "result" } ? ] bi
<effect> dup . ;
<effect> ;
:: define-ffi-signal ( signal class -- word ) ! сделать попонятнее
signal dup .
signal
[
name>> class c-type>> swap ":" glue create-in
[ void* swap typedef ] keep dup
@ -75,12 +75,13 @@ IN: gir.ffi
} case ;
: define-ffi-enum ( enum -- word )
[ c-type>> (CREATE-C-TYPE) dup ]
[
members>> [
[ c-identifier>> create-in ]
[ value>> ] bi define-constant
] each
] [ c-type>> create-in [ int swap typedef ] keep ] bi ;
[ value>> ] bi 2array
] map
] bi int swap define-enum ;
: define-ffi-enums ( enums -- )
[ define-ffi-enum ] define-each ;
@ -88,9 +89,33 @@ IN: gir.ffi
: define-ffi-bitfields ( bitfields -- )
[ define-ffi-enum ] define-each ;
: fields>struct-slots ( fields -- slots )
[
[ name>> ] [ c-type>> string>c-type ]
[ drop { } ] tri <struct-slot-spec>
] map ;
! Сделать для всех типов создание DEFER:
: define-ffi-record-defer ( record -- word )
c-type>> create-in void* swap [ typedef ] keep ;
: define-ffi-records-defer ( records -- )
[ define-ffi-record-defer ] define-each ;
: define-ffi-record ( record -- word )
dup ffi>> forget
dup {
[ fields>> empty? not ]
[ c-type>> implement-structs get-global member? ]
} 1&&
[
dup .
[ c-type>> create-class-in dup ]
[ fields>> fields>struct-slots ] bi define-struct-class
] [
[ disguised?>> void* void ? ]
[ c-type>> create-in ] bi [ typedef ] keep ;
[ c-type>> create-in ] bi [ typedef ] keep
] if ;
: define-ffi-records ( records -- )
[ define-ffi-record ] define-each ;
@ -185,7 +210,7 @@ IN: gir.ffi
: prepare-vocab ( repository -- )
includes>> lib-aliases get '[ _ at ] map sift
[ ffi-vocab "." glue ] map
{ "alien.c-types" } append
! { "alien.c-types" } append
[ dup using-vocab? [ drop ] [ use-vocab ] if ] each ;
: define-ffi-namespace ( namespace -- )
@ -194,11 +219,15 @@ IN: gir.ffi
[ consts>> define-ffi-consts ]
[ enums>> define-ffi-enums ]
[ bitfields>> define-ffi-bitfields ]
[ records>> define-ffi-records ]
[ records>> define-ffi-records-defer ]
[ unions>> define-ffi-unions ]
[ interfaces>> define-ffi-interfaces ]
[ classes>> define-ffi-classes ]
[ callbacks>> define-ffi-callbacks ]
[ records>> define-ffi-records ]
[ records>> define-ffi-records-content ]
[ classes>> define-ffi-classes-content ]
[ interfaces>> define-ffi-interfaces-content ]

9
basis/gir/gir.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs combinators gir.common gir.ffi gir.loader
kernel lexer locals namespaces sequences vocabs.parser xml ;
kernel lexer locals namespaces prettyprint sequences vocabs.parser xml ;
IN: gir
: with-child-vocab ( name quot -- )
@ -12,6 +12,7 @@ IN: gir
:: define-gir-vocab ( vocab-name file-name -- )
file-name file>xml xml>repository
implement-structs get-global .
vocab-name [ set-current-vocab ] [ current-lib set ] bi
{
[
@ -19,6 +20,10 @@ IN: gir
lib-aliases get set-at
]
[ ffi-vocab [ define-ffi-repository ] with-child-vocab ]
} cleave ;
} cleave
f implement-structs set-global ;
SYNTAX: IN-GIR: scan scan define-gir-vocab ;
SYNTAX: IMPLEMENT-STRUCTS:
";" parse-tokens implement-structs set-global ;

18
basis/gir/loader/loader.factor
View File

@ -42,6 +42,7 @@ IN: gir.loader
}
{ "type" [ node>type f swap ] }
{ "varargs" [ drop f f ] }
{ "callback" [ drop f "any" f type boa ] }
} case ;
: load-parameter ( param xml -- param )
@ -188,10 +189,27 @@ IN: gir.loader
[ "member" tags-named [ xml>member ] map >>members ]
} cleave ;
: xml>field ( xml -- field )
[ field new ] dip {
[ "name" attr >>name ]
[ "writable" attr "1" = >>writable? ]
! Для некоторых field есть callback в качестве типа, решить, как лучше сделать
[
first-child-tag dup name>> main>> "callback" =
[ drop "gpointer" ] [ "type" attr ] if
>>c-type
]
[
first-child-tag xml>type
[ [ >>array-info ] [ >>type ] bi* ] [ 2drop f ] if*
]
} cleave ;
: xml>record ( xml -- record )
[ record new ] dip {
[ load-type ]
[ "disguised" attr "1" = >>disguised? ]
[ "field" tags-named [ xml>field ] map >>fields ]
[ "constructor" load-functions >>constructors ]
[ "function" load-functions >>functions ]
[

5
basis/gir/repository/repository.factor
View File

@ -20,8 +20,11 @@ TUPLE: const < typed value ffi ;
TUPLE: type-node < node
type c-type type-name get-type ffi ;
TUPLE: field < typed
writable? length? array-info ;
TUPLE: record < type-node
constructors methods functions disguised? ;
fields constructors methods functions disguised? ;
TUPLE: union < type-node ;

3
basis/glib/glib.factor
View File

@ -58,7 +58,8 @@ TYPEDEF: guint32 gunichar
TYPEDEF: guint16 gunichar2
! Разобраться, почему в .gir есть такие типы
TYPEDEF: void any
TYPEDEF: gpointer pointer
TYPEDEF: gpointer any
IN-GIR: glib vocab:glib/GLib-2.0.gir

3
basis/gobject/gobject.factor
View File

@ -1,8 +1,9 @@
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax alien.c-types alien.destructors
USING: alien.syntax alien.destructors
alien.libraries combinators kernel literals math system
gir glib glib.ffi ;
EXCLUDE: alien.c-types => pointer ;
IN: gobject.ffi

1
basis/gst/gst.factor
View File

@ -3,6 +3,7 @@
USING: alien.syntax alien.libraries combinators
kernel system
gir glib glib.ffi gobject gmodule ;
EXCLUDE: alien.c-types => pointer ;
<<
"gst" {

1
basis/gtk/gl/gl.factor
View File

@ -2,6 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax alien.libraries combinators kernel system
gir glib gobject gio gmodule gdk.pixbuf gdk gdk.gl gtk gtk.ffi ;
EXCLUDE: alien.c-types => pointer ;
<<
"gtk.gl" {

1
basis/gtk/gtk.factor
View File

@ -3,6 +3,7 @@
USING: alien.syntax alien.libraries cairo.ffi combinators
kernel system
gir glib glib.ffi gobject gio gmodule gdk.pixbuf gdk atk ;
EXCLUDE: alien.c-types => pointer ;
<<
"gtk" {

2
basis/pango/pango.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2009 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.syntax alien.c-types alien.destructors
USING: accessors alien alien.syntax alien.c-types alien.destructors
alien.strings alien.libraries arrays classes.struct combinators
destructors fonts init kernel math math.rectangles memoize
io.encodings.utf8 system

15
extra/gir/samples/lowlevel/opengl/opengl.factor
View File

@ -53,27 +53,22 @@ IN: gir.samples.lowlevel.opengl
[ 200 200 gtk_window_set_default_size ]
[ GTK_WIN_POS_CENTER gtk_window_set_position ] tri
window 1 gtk_container_set_reallocate_redraws
! window 1 gtk_container_set_reallocate_redraws
GDK_GL_MODE_RGBA GDK_GL_MODE_DOUBLE bitor
gdk_gl_config_new_by_mode :> gl-config
gtk_drawing_area_new :> drawing-area
drawing-area 200 200 gtk_widget_set_size_request
window gl-config f 1 GDK_GL_RGBA_TYPE
gtk_widget_set_gl_capability drop
drawing-area gl-config f 1 GDK_GL_RGBA_TYPE
gtk_widget_set_gl_capability .
drawing-area "configure-event" utf8 string>alien
window "configure-event" utf8 string>alien
[ on-configure ] GtkWidget:configure-event
f f 0 g_signal_connect_data drop
drawing-area "expose-event" utf8 string>alien
window "expose-event" utf8 string>alien
[ on-expose ] GtkWidget:expose-event
f f 0 g_signal_connect_data drop
window drawing-area gtk_container_add
window ;
:: opengl-main ( -- )