event fixes

cvs
Slava Pestov 2004-10-21 01:49:10 +00:00
parent 6865ffd517
commit d08ef9defd
4 changed files with 31 additions and 14 deletions

View File

@ -60,6 +60,7 @@ USE: words
: 2>rect ( x y -- x:re x:im y:re y:im ) >r >rect r> >rect ; : 2>rect ( x y -- x:re x:im y:re y:im ) >r >rect r> >rect ;
: complex= ( x y -- ? ) 2>rect 2= ; : complex= ( x y -- ? ) 2>rect 2= ;
: complex+ ( x y -- x+y ) 2>rect swapd + >r + r> rect> ; : complex+ ( x y -- x+y ) 2>rect swapd + >r + r> rect> ;
: complex- ( x y -- x-y ) 2>rect swapd - >r - r> rect> ; : complex- ( x y -- x-y ) 2>rect swapd - >r - r> rect> ;
: complex*re ( x y -- zx:re * y:re x:im * r:im ) : complex*re ( x y -- zx:re * y:re x:im * r:im )

View File

@ -89,6 +89,10 @@ BEGIN-STRUCT: keyboard-event
FIELD: uchar type ! SDL_KEYDOWN or SDL_KEYUP FIELD: uchar type ! SDL_KEYDOWN or SDL_KEYUP
FIELD: uchar which ! The keyboard device index FIELD: uchar which ! The keyboard device index
FIELD: uchar state ! SDL_PRESSED or SDL_RELEASED FIELD: uchar state ! SDL_PRESSED or SDL_RELEASED
! YUCK!
FIELD: uchar pad
FIELD: uchar pad
FIELD: uchar pad
! Later: inline structs ! Later: inline structs
FIELD: uchar scancode FIELD: uchar scancode
FIELD: int sym FIELD: int sym
@ -109,8 +113,8 @@ END-STRUCT
BEGIN-STRUCT: button-event BEGIN-STRUCT: button-event
FIELD: uchar type ! SDL_MOUSEBUTTONDOWN or SDL_MOUSEBUTTONUP FIELD: uchar type ! SDL_MOUSEBUTTONDOWN or SDL_MOUSEBUTTONUP
FIELD: uchar which ! The mouse device index FIELD: uchar which ! The mouse device index
FIELD: uchar button; ! The mouse button index FIELD: uchar button ! The mouse button index
FIELD: uchar state; ! SDL_PRESSED or SDL_RELEASED FIELD: uchar state ! SDL_PRESSED or SDL_RELEASED
FIELD: ushort x FIELD: ushort x
FIELD: ushort y ! The X/Y coordinates of the mouse at press time FIELD: ushort y ! The X/Y coordinates of the mouse at press time
END-STRUCT END-STRUCT

View File

@ -11,6 +11,7 @@ USE: errors
USE: combinators USE: combinators
USE: lists USE: lists
USE: logic USE: logic
USE: prettyprint
SYMBOL: surface SYMBOL: surface
SYMBOL: width SYMBOL: width
@ -44,13 +45,13 @@ SYMBOL: height
] ifte SDL_Flip ] ifte SDL_Flip
] with-scope ; ] with-scope ;
! : event-loop ( event -- ) : event-loop ( event -- )
! dup SDL_WaitEvent 1 = [ dup SDL_WaitEvent 1 = [
! dup event-type SDL_QUIT = [ dup event-type SDL_QUIT = [
! drop drop
! ] [ ] [
! event-loop event-loop
! ] ifte ] ifte
! ] [ ] [
! drop drop
! ] ifte ; ] ifte ;

View File

@ -83,6 +83,13 @@ BEGIN-STRUCT: format
FIELD: uchar alpha FIELD: uchar alpha
END-STRUCT END-STRUCT
BEGIN-STRUCT: rect
FIELD: short clip-x
FIELD: short clip-y
FIELD: ushort clip-w
FIELD: ushort clip-h
END-STRUCT
BEGIN-STRUCT: surface BEGIN-STRUCT: surface
FIELD: uint flags FIELD: uint flags
FIELD: format* format FIELD: format* format
@ -94,8 +101,8 @@ BEGIN-STRUCT: surface
FIELD: void* hwdata FIELD: void* hwdata
FIELD: short clip-x FIELD: short clip-x
FIELD: short clip-y FIELD: short clip-y
FIELD: short clip-w FIELD: ushort clip-w
FIELD: short clip-h FIELD: ushort clip-h
FIELD: uint unused1 FIELD: uint unused1
FIELD: uint locked FIELD: uint locked
FIELD: int map FIELD: int map
@ -144,6 +151,10 @@ END-STRUCT
! SDL_SetGamma: float types ! SDL_SetGamma: float types
: SDL_FillRect ( surface rect color -- n )
"int" "sdl" "SDL_FillRect"
[ "surface*" "rect*" "unint" ] alien-call ;
: SDL_LockSurface ( surface -- ) : SDL_LockSurface ( surface -- )
"int" "sdl" "SDL_LockSurface" [ "surface*" ] alien-call ; "int" "sdl" "SDL_LockSurface" [ "surface*" ] alien-call ;