event fixes
parent
6865ffd517
commit
d08ef9defd
|
@ -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 )
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue