union types in FFI

diff --git a/library/compiler/alien-types.factor b/library/compiler/alien-types.factor
index 83c2a4ebb0252136945ed615aae67f14c50d8083..2bbd84b965ca095f457a59a1193284da22c54e1f 100644 (file)
--- a/library/compiler/alien-types.factor
+++ b/library/compiler/alien-types.factor
@@ -83,7 +83,10 @@ USE: words
     3dup define-getter 3dup define-setter
     drop [ "width" get ] bind + ;
 
-: define-constructor ( len -- )
+: define-member ( max type -- max )
+    c-type [ "width" get ] bind max ;
+
+: define-constructor ( width -- )
     #! Make a word <foo> where foo is the structure name that
     #! allocates a Factor heap-local instance of this structure.
     #! Used for C functions that expect you to pass in a struct.
@@ -92,14 +95,11 @@ USE: words
     "in" get create swap
     define-compound ;
 
-: define-struct-type ( -- )
-    #! The setter just throws an error for now.
-    [
-        [ alien-cell <alien> ] "getter" set
-        "unbox_alien" "unboxer" set
-        "box_alien" "boxer" set
-        cell "width" set
-    ] "struct-name" get "*" cat2 define-c-type ;
+: define-struct-type ( width -- )
+    #! Define inline and pointer type for the struct. Pointer
+    #! type is exactly like void*.
+    [ "width" set ] "struct-name" get define-c-type
+    "void*" c-type "struct-name" get "*" cat2 c-types set* ;
 
 : BEGIN-STRUCT: ( -- offset )
     scan "struct-name" set  0 ; parsing
@@ -108,7 +108,16 @@ USE: words
     scan scan define-field ; parsing
 
 : END-STRUCT ( length -- )
-    define-constructor define-struct-type ; parsing
+    dup define-constructor define-struct-type ; parsing
+
+: BEGIN-UNION: ( -- max )
+    scan "struct-name" set  0 ; parsing
+
+: MEMBER: ( max -- max )
+    scan define-member ; parsing
+
+: END-UNION ( max -- )
+    dup define-constructor define-struct-type ; parsing
 
 global [ <namespace> "c-types" set ] bind
 

diff --git a/library/platform/native/prettyprint.factor b/library/platform/native/prettyprint.factor
index c720821d4787c9a8de860342215b9c667c590588..cfa2e56f505d40ce04bb078327ee7bfbcbfa00bf 100644 (file)
--- a/library/platform/native/prettyprint.factor
+++ b/library/platform/native/prettyprint.factor
@@ -78,5 +78,6 @@ USE: words
         [ compound? ] [ see-compound ]
         [ symbol? ] [ see-symbol ]
         [ primitive? ] [ see-primitive ]
-        [ drop t ] [ see-undefined ]
+        [ word? ] [ see-undefined ]
+        [ drop t ] [ "Not a word: " write . ]
     ] cond ;

diff --git a/library/sdl/sdl-event.factor b/library/sdl/sdl-event.factor
index fd50d6c2256a204508a33aeeeff23bd4fc4135be..98fe9dfd62a02dba41f7174572eec1e108028338 100644 (file)
--- a/library/sdl/sdl-event.factor
+++ b/library/sdl/sdl-event.factor
@@ -1,4 +1,4 @@
-! :folding=indent:collapseFolds=1:
+! :folding=indent:collapseFolds=1:sidekick.parser=none:
 
 ! $Id$
 !
@@ -59,13 +59,135 @@ END-ENUM
 : SDL_USEREVENT 24 ;
 : SDL_MAXEVENT  32 ;
 
+: SDL_ACTIVEEVENTMASK     2      ;
+: SDL_KEYDOWNMASK         4      ;
+: SDL_KEYUPMASK           8      ;
+: SDL_MOUSEMOTIONMASK     16     ;
+: SDL_MOUSEBUTTONDOWNMASK 32     ;
+: SDL_MOUSEBUTTONUPMASK   64     ;
+: SDL_MOUSEEVENTMASK      112    ;
+: SDL_JOYAXISMOTIONMASK   128    ;
+: SDL_JOYBALLMOTIONMASK   256    ;
+: SDL_JOYHATMOTIONMASK    512    ;
+: SDL_JOYBUTTONDOWNMASK   1024   ;
+: SDL_JOYBUTTONUPMASK    2048   ;
+: SDL_JOYEVENTMASK           3968   ;
+: SDL_VIDEORESIZEMASK    65536  ;
+: SDL_VIDEOEXPOSEMASK    131072 ;
+: SDL_QUITMASK               4096   ;
+: SDL_SYSWMEVENTMASK     8192   ;
+
+: SDL_ALLEVENTS           HEX: ffffffff ;
+
+BEGIN-STRUCT: active-event
+    FIELD: uchar type  ! SDL_ACTIVEEVENT
+    FIELD: uchar gain  ! Whether given states were gained or lost (1/0)
+    FIELD: uchar state ! A mask of the focus states
+END-STRUCT
+
+BEGIN-STRUCT: keyboard-event
+    FIELD: uchar type  ! SDL_KEYDOWN or SDL_KEYUP
+    FIELD: uchar which ! The keyboard device index
+    FIELD: uchar state ! SDL_PRESSED or SDL_RELEASED
+    ! Later: inline structs
+    FIELD: uchar scancode
+    FIELD: int sym
+    FIELD: int mod
+    FIELD: ushort unicode
+END-STRUCT
+
+BEGIN-STRUCT: motion-event
+    FIELD: uchar type  ! SDL_MOUSEMOTION
+    FIELD: uchar which ! The mouse device index
+    FIELD: uchar state ! The current button state
+    FIELD: ushort x    ! The X/Y coordinates of the mouse
+    FIELD: ushort y
+    FIELD: short xrel  ! The relative motion in the X direction
+    FIELD: short yrel  ! The relative motion in the Y direction 
+END-STRUCT             
+
+BEGIN-STRUCT: button-event
+       FIELD: uchar type    ! SDL_MOUSEBUTTONDOWN or SDL_MOUSEBUTTONUP
+       FIELD: uchar which   ! The mouse device index
+       FIELD: uchar button; ! The mouse button index
+       FIELD: uchar state;  ! SDL_PRESSED or SDL_RELEASED
+       FIELD: ushort x
+    FIELD: ushort y      ! The X/Y coordinates of the mouse at press time
+END-STRUCT
+
+BEGIN-STRUCT: joy-axis-event
+       FIELD: uchar type   ! SDL_JOYAXISMOTION
+    FIELD: uchar which  ! The joystick device index
+    FIELD: uchar axis   ! The joystick axis index
+    FIELD: short value  ! The axis value
+END-STRUCT
+
+BEGIN-STRUCT: joy-ball-event
+    FIELD: uchar type  ! SDL_JOYBALLMOTION
+    FIELD: uchar which ! The joystick device index
+    FIELD: uchar ball  ! The joystick trackball index
+    FIELD: short xrel  ! The relative motion in the X direction
+    FIELD: short yrel  ! The relative motion in the Y direction
+END-STRUCT
+
+BEGIN-STRUCT: joy-hat-event
+    FIELD: uchar type  ! SDL_JOYHATMOTION
+    FIELD: uchar which ! The joystick device index
+    FIELD: uchar hat   ! The joystick hat index
+    FIELD: uchar value ! The hat position value:
+        ! SDL_HAT_LEFTUP   SDL_HAT_UP       SDL_HAT_RIGHTUP
+        ! SDL_HAT_LEFT     SDL_HAT_CENTERED SDL_HAT_RIGHT
+        ! SDL_HAT_LEFTDOWN SDL_HAT_DOWN     SDL_HAT_RIGHTDOWN
+        ! Note that zero means the POV is centered.
+END-STRUCT       
+
+BEGIN-STRUCT: joy-button-event
+       FIELD: uchar type   ! SDL_JOYBUTTONDOWN or SDL_JOYBUTTONUP
+       FIELD: uchar which  ! The joystick device index
+       FIELD: uchar button ! The joystick button index
+       FIELD: uchar state  ! SDL_PRESSED or SDL_RELEASED
+END-STRUCT
+
+BEGIN-STRUCT: resize-event
+    FIELD: uchar type ! SDL_VIDEORESIZE
+    FIELD: int w      ! New width
+    FIELD: int h      ! New height
+END-STRUCT
+
+BEGIN-STRUCT: expose-event
+    FIELD: uchar type ! SDL_VIDEOEXPOSE
+END-STRUCT
+
+BEGIN-STRUCT: quit-event
+    FIELD: uchar type ! SDL_QUIT
+END-STRUCT
+
+BEGIN-STRUCT: user-event
+    FIELD: uchar type ! SDL_USREVENT through SDL_NUMEVENTS-1
+    FIELD: int code
+    FIELD: void* data1
+    FIELD: void* data2
+END-STRUCT
+
 BEGIN-STRUCT: event
-    FIELD: char type
-    FIELD: int unused
-    FIELD: int unused
-    FIELD: int unused
-    FIELD: int unused
+    FIELD: uchar type
 END-STRUCT
 
+BEGIN-UNION: event
+    MEMBER: event
+    MEMBER: active-event
+    MEMBER: keyboard-event
+    MEMBER: motion-event
+    MEMBER: button-event
+    MEMBER: joy-axis-event
+    MEMBER: joy-ball-event
+    MEMBER: joy-hat-event
+    MEMBER: joy-button-event
+    MEMBER: resize-event
+    MEMBER: expose-event
+    MEMBER: quit-event
+    MEMBER: user-event
+END-UNION
+
 : SDL_WaitEvent ( event -- )
     "int" "sdl" "SDL_WaitEvent" [ "event*" ] alien-call ;

diff --git a/library/sdl/sdl-utils.factor b/library/sdl/sdl-utils.factor
index 51ad79080910bf3852dc4c28fc1b2a4f5987a1ce..3f48c7a49e2a0f8bae6857bede5f741b879ba3d3 100644 (file)
--- a/library/sdl/sdl-utils.factor
+++ b/library/sdl/sdl-utils.factor
@@ -44,13 +44,13 @@ SYMBOL: height
         ] ifte SDL_Flip
     ] with-scope ;
 
-: event-loop ( event -- )
-    dup SDL_WaitEvent 1 = [
-        dup event-type SDL_QUIT = [
-            drop
-        ] [
-            event-loop
-        ] ifte
-    ] [
-        drop
-    ] ifte ;
+! : event-loop ( event -- )
+!     dup SDL_WaitEvent 1 = [
+!         dup event-type SDL_QUIT = [
+!             drop
+!         ] [
+!             event-loop
+!         ] ifte
+!     ] [
+!         drop
+!     ] ifte ;

diff --git a/library/test/words.factor b/library/test/words.factor
index 670b779750ac1dc6e07c7e8e55aff2b1f853d597..7453d639bcb1e9e139739db0e6eb22b3987d7a61 100644 (file)
--- a/library/test/words.factor
+++ b/library/test/words.factor
@@ -5,6 +5,8 @@ USE: words
 USE: namespaces
 USE: logic
 USE: lists
+USE: stack
+USE: kernel
 
 [ 4 ] [
     "poo" "scratchpad" create [ 2 2 + ] define-compound
@@ -38,3 +40,15 @@ word word-name "last-word-test" set
 [ { 1 2 } ] [
     "create-test" [ "scratchpad" ] search "testing" word-property
 ] unit-test
+
+[
+    <namespace> "vocabularies" set
+    
+    [ t ] [ \ car "car" [ "lists" ] search = ] unit-test
+
+    "test-scope" "scratchpad" create drop
+] with-scope
+
+[ "test-scope" ] [
+    "test-scope" [ "scratchpad" ] search word-name
+] unit-test