53 lines
1.5 KiB
Factor
53 lines
1.5 KiB
Factor
IN: factoroids
|
|
USING: alien generic hashtables io kernel math namespaces sdl
|
|
sequences ;
|
|
|
|
: fire ( -- )
|
|
player get [
|
|
dup body-position over body-direction 3 v*n v+
|
|
swap body-angle
|
|
] keep spawn-rocket ;
|
|
|
|
: turn-left ( ? actor -- )
|
|
swap [ 1 ] [ dup body-angle-delta 0 < -1 0 ? ] if 30 /f
|
|
swap set-body-angle-delta ;
|
|
|
|
: turn-right ( ? actor -- )
|
|
swap [ -1 ] [ dup body-angle-delta 0 > 1 0 ? ] if 30 /f
|
|
swap set-body-angle-delta ;
|
|
|
|
: forward ( ? actor -- )
|
|
swap [ 1 ] [ dup body-acceleration 0 < -1 0 ? ] if 6000 /f
|
|
swap set-body-acceleration ;
|
|
|
|
: backward ( ? actor -- )
|
|
swap [ -1 ] [ dup body-acceleration 0 > 1 0 ? ] if 60000 /f
|
|
swap set-body-acceleration ;
|
|
|
|
: binding ( binding -- { down up } )
|
|
keyboard-event>binding H{
|
|
[[ [ "SPACE" ] { [ fire ] [ ] } ]]
|
|
[[ [ "LEFT" ] { [ t player get turn-left ] [ f player get turn-left ] } ]]
|
|
[[ [ "RIGHT" ] { [ t player get turn-right ] [ f player get turn-right ] } ]]
|
|
[[ [ "UP" ] { [ t player get forward ] [ f player get forward ] } ]]
|
|
[[ [ "DOWN" ] { [ t player get backward ] [ f player get backward ] } ]]
|
|
} hash ;
|
|
|
|
GENERIC: handle-event ( event -- quit? )
|
|
|
|
M: object handle-event ( event -- quit? )
|
|
drop f ;
|
|
|
|
M: quit-event handle-event ( event -- quit? )
|
|
drop t ;
|
|
|
|
M: key-down-event handle-event ( event -- quit? )
|
|
binding first call f ;
|
|
|
|
M: key-up-event handle-event ( event -- quit? )
|
|
binding second call f ;
|
|
|
|
: check-event ( -- ? )
|
|
"event" <c-object> dup SDL_PollEvent
|
|
[ handle-event ] [ drop f ] if ;
|