diff --git a/basis/gdk/gdk.factor b/basis/gdk/gdk.factor index fc414cbce4..a91962a23c 100644 --- a/basis/gdk/gdk.factor +++ b/basis/gdk/gdk.factor @@ -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 diff --git a/basis/gdk/pixbuf/pixbuf.factor b/basis/gdk/pixbuf/pixbuf.factor index d9550bd44c..7f6dcf1600 100644 --- a/basis/gdk/pixbuf/pixbuf.factor +++ b/basis/gdk/pixbuf/pixbuf.factor @@ -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 diff --git a/basis/gio/gio.factor b/basis/gio/gio.factor index bd20272f77..341997fb50 100644 --- a/basis/gio/gio.factor +++ b/basis/gio/gio.factor @@ -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 diff --git a/basis/gir/common/common.factor b/basis/gir/common/common.factor index 10e7820432..e8b7569b73 100644 --- a/basis/gir/common/common.factor +++ b/basis/gir/common/common.factor @@ -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 ; diff --git a/basis/gir/ffi/ffi.factor b/basis/gir/ffi/ffi.factor index a233f35794..2f82345739 100644 --- a/basis/gir/ffi/ffi.factor +++ b/basis/gir/ffi/ffi.factor @@ -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 - dup . ; + ; :: 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 + ] 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 ) - [ disguised?>> void* void ? ] - [ c-type>> create-in ] bi [ typedef ] keep ; + 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 + ] 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 ] diff --git a/basis/gir/gir.factor b/basis/gir/gir.factor index 6483d18e35..283fb2caf9 100755 --- a/basis/gir/gir.factor +++ b/basis/gir/gir.factor @@ -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 ; diff --git a/basis/gir/loader/loader.factor b/basis/gir/loader/loader.factor index 410380e639..5902b90b26 100644 --- a/basis/gir/loader/loader.factor +++ b/basis/gir/loader/loader.factor @@ -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 ] [ diff --git a/basis/gir/repository/repository.factor b/basis/gir/repository/repository.factor index 5a067850fc..4fb43c44e3 100644 --- a/basis/gir/repository/repository.factor +++ b/basis/gir/repository/repository.factor @@ -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 ; diff --git a/basis/glib/glib.factor b/basis/glib/glib.factor index e8aa1688df..ec8aedaa96 100644 --- a/basis/glib/glib.factor +++ b/basis/glib/glib.factor @@ -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 diff --git a/basis/gobject/gobject.factor b/basis/gobject/gobject.factor index d9135119ad..d2274d74a7 100644 --- a/basis/gobject/gobject.factor +++ b/basis/gobject/gobject.factor @@ -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 diff --git a/basis/gst/gst.factor b/basis/gst/gst.factor index a386e7d4b8..41723b78ae 100644 --- a/basis/gst/gst.factor +++ b/basis/gst/gst.factor @@ -3,6 +3,7 @@ USING: alien.syntax alien.libraries combinators kernel system gir glib glib.ffi gobject gmodule ; +EXCLUDE: alien.c-types => pointer ; << "gst" { diff --git a/basis/gtk/gl/gl.factor b/basis/gtk/gl/gl.factor index 53569b6c62..01b3180509 100644 --- a/basis/gtk/gl/gl.factor +++ b/basis/gtk/gl/gl.factor @@ -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" { diff --git a/basis/gtk/gtk.factor b/basis/gtk/gtk.factor index 1882eb8ac6..7aede500e0 100644 --- a/basis/gtk/gtk.factor +++ b/basis/gtk/gtk.factor @@ -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" { diff --git a/basis/pango/pango.factor b/basis/pango/pango.factor index aba7528089..a460919d24 100644 --- a/basis/pango/pango.factor +++ b/basis/pango/pango.factor @@ -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 diff --git a/extra/gir/samples/lowlevel/opengl/opengl.factor b/extra/gir/samples/lowlevel/opengl/opengl.factor index d4cbbc5f12..bf3dd06edf 100644 --- a/extra/gir/samples/lowlevel/opengl/opengl.factor +++ b/extra/gir/samples/lowlevel/opengl/opengl.factor @@ -53,26 +53,21 @@ 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 + f f 0 g_signal_connect_data drop window ;