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

union types in FFI

cvs
Slava Pestov 2004-10-19 16:32:54 +00:00
parent 1aef8c48a0
commit 6865ffd517
5 changed files with 174 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
library/compiler/alien-types.factor
View File

@ -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

3
library/platform/native/prettyprint.factor
View File

@ -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 ;

136
library/sdl/sdl-event.factor
View File

@ -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 ;
BEGIN-STRUCT: event
FIELD: char type
FIELD: int unused
FIELD: int unused
FIELD: int unused
FIELD: int unused
: 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: 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 ;

20
library/sdl/sdl-utils.factor
View File

@ -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 ;

14
library/test/words.factor
View File

@ -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