add generation of records as STRUCT: with slots when the record is listed in IMPLEMEN...

diff --git a/basis/gdk/gdk.factor b/basis/gdk/gdk.factor
index fc414cbce4a7294a82550dc947ab90c92867edde..a91962a23c0272a755080c455385c9d4d506fb86 100644 (file)
--- 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 d9550bd44c07ec2d0e08beb42c44084d6ea21602..7f6dcf1600a870619c8dd3172da729dd6d294531 100644 (file)
--- 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 bd20272f776becf5a3cb01894e63b687ee2947de..341997fb50f6780203ebac079696b684dda9171b 100644 (file)
--- 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 10e7820432c1e3a8423def1d92113277c803f0bc..e8b7569b73e7da64d8ad90756c9906b7b1585f35 100644 (file)
--- 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 a233f35794e597584907483351179359b0bc30ef..2f8234573912e45ff31f413ead08fe8aecc775c7 100644 (file)
--- 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
-    <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 )
-    [ 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 6483d18e3552766ada0e0af5fbb713daad3fc26d..283fb2caf921db9f88039711514bd1e3ce274dc8 100755 (executable)
--- 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 410380e6395b9a0d626cd01e4cbaa0089ad70da0..5902b90b2623e1cbe9c7ebb1d61fcf56af701968 100644 (file)
--- 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 5a067850fc7c63596b02957a5d504e7e9fc4d5b0..4fb43c44e34bb3fde0020fd57b5540ce0522ca11 100644 (file)
--- 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 e8aa1688dffd1946ca0754f996ef38f1b10ec86a..ec8aedaa96d5b85084fce5c47d9b6999c8f572dd 100644 (file)
--- 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 d9135119addf3ba7507e6ccd390aa3d1c64cb2b7..d2274d74a7f1189925722389d9fef6874d9d4124 100644 (file)
--- 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 a386e7d4b85f4ae83faa2c7c8d39742c24f1ca80..41723b78aec43460ac171c67a586ca9018225db9 100644 (file)
--- 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 53569b6c62b1cf76c7541067245eca51c3d3d392..01b3180509cd64c55f24e89f4c9067bb779f4a7e 100644 (file)
--- 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 1882eb8ac64f30a863d2dd84780bb309494c432f..7aede500e0977a13d878fdb3061054929a541500 100644 (file)
--- 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 aba7528089c5122df90b8ca9658f58ca3fb73db7..a460919d243e6485a49ad6a5346ec4d02ed86c6f 100644 (file)
--- 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 d4cbbc5f12637e5322b3e7471ba59eb18e6da471..bf3dd06edfdb13b53ea323b0c6fe18c37d80b96b 100644 (file)
--- 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 ;