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

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
 

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
 

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
 

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 ;

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
+USING: accessors alien alien.c-types alien.enums alien.parser arrays assocs classes.parser
-combinators.short-circuit effects fry generalizations
+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
+           [ value>> ] bi 2array
-       ] each 
+       ] map 
-    ] [ c-type>> create-in [ int swap typedef ] keep ] bi ;
+    ] 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 ]

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 ;

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 ]
         [

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 ;
 

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
 

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
 

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" {

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" {

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" {

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

extra/gir/samples/lowlevel/opengl/opengl.factor

@@ -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
+    window gl-config f 1 GDK_GL_RGBA_TYPE
-    drawing-area 200 200 gtk_widget_set_size_request
+    gtk_widget_set_gl_capability drop
 
-    drawing-area gl-config f 1 GDK_GL_RGBA_TYPE
+    window "configure-event" utf8 string>alien
-    gtk_widget_set_gl_capability .
-
-    drawing-area "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 ( -- )