2005-11-15 03:19:57 -05:00
|
|
|
USING: arrays gadgets generic hashtables io kernel math
|
2005-11-15 23:25:22 -05:00
|
|
|
namespaces opengl prettyprint sdl sequences threads ;
|
2005-11-15 03:19:57 -05:00
|
|
|
IN: factoroids
|
|
|
|
|
|
|
|
|
|
SYMBOL: player
|
|
|
|
|
SYMBOL: actors
|
|
|
|
|
|
|
|
|
|
: add-actor dup actors get push ;
|
|
|
|
|
|
|
|
|
|
: remove-actor actors get delete ;
|
|
|
|
|
|
2005-11-19 04:09:30 -05:00
|
|
|
: default-priority 0 ;
|
|
|
|
|
: projectile-priority 1 ;
|
|
|
|
|
: powerup-priority 1 ;
|
|
|
|
|
|
|
|
|
|
! model: see models.factor
|
|
|
|
|
! colors: a sequence to color parts of the model
|
|
|
|
|
! up: an orientation vector for rotation
|
|
|
|
|
! expiry: f or a time when the actor will cease to exist
|
|
|
|
|
! shield: f if invincible, otherwise an integer
|
|
|
|
|
! max-shield: shield is set to max-shield when we recharge
|
|
|
|
|
! priority: when two actors collide, the one with highest
|
|
|
|
|
! priority has its collision generic word called
|
|
|
|
|
! ai: object responding to ai-tick generic
|
|
|
|
|
TUPLE: actor model colors up expiry shield max-shield priority ai ;
|
2005-11-15 03:19:57 -05:00
|
|
|
|
2005-11-15 23:25:22 -05:00
|
|
|
C: actor ( model colors position angle size -- actor )
|
|
|
|
|
[ >r <body> r> set-delegate ] keep
|
|
|
|
|
[ set-actor-colors ] keep
|
2005-11-19 04:09:30 -05:00
|
|
|
[ set-actor-model ] keep
|
|
|
|
|
default-priority over set-actor-priority ;
|
2005-11-15 03:19:57 -05:00
|
|
|
|
2005-11-15 23:25:22 -05:00
|
|
|
GENERIC: can-collide* ( actor actor -- ? )
|
2005-11-15 03:19:57 -05:00
|
|
|
|
2005-11-15 23:25:22 -05:00
|
|
|
M: actor can-collide* ( actor actor -- ) 2drop t ;
|
2005-11-15 03:19:57 -05:00
|
|
|
|
2005-11-15 23:25:22 -05:00
|
|
|
GENERIC: collision
|
2005-11-15 03:19:57 -05:00
|
|
|
|
2005-11-15 23:25:22 -05:00
|
|
|
M: actor collision ( actor actor -- ) drop remove-actor ;
|
2005-11-15 03:19:57 -05:00
|
|
|
|
2005-11-19 04:09:30 -05:00
|
|
|
: can-collide? ( a1 a2 -- ? )
|
|
|
|
|
#! If true, a collision test is performed, and a2's
|
|
|
|
|
#! collision generic is called.
|
|
|
|
|
2dup eq? >r over actor-priority over actor-priority > r> or
|
|
|
|
|
[ 2drop f ] [ can-collide* ] if ;
|
2005-11-15 03:19:57 -05:00
|
|
|
|
2005-11-15 23:25:22 -05:00
|
|
|
: collidable ( actor -- seq )
|
|
|
|
|
actors get [ can-collide? ] subset-with ;
|
2005-11-15 03:19:57 -05:00
|
|
|
|
2005-11-15 23:25:22 -05:00
|
|
|
: ?collision ( actor actor -- )
|
2005-11-19 04:09:30 -05:00
|
|
|
2dup [ body-position ] 2apply v- norm 1 <=
|
2005-11-15 23:25:22 -05:00
|
|
|
[ 2dup collision 2dup swap collision ] when 2drop ;
|
2005-11-15 03:19:57 -05:00
|
|
|
|
2005-11-15 23:25:22 -05:00
|
|
|
: ?collisions ( actor -- )
|
|
|
|
|
dup collidable [ ?collision ] each-with ;
|
2005-11-15 03:19:57 -05:00
|
|
|
|
2005-11-15 23:25:22 -05:00
|
|
|
: ?expire-actor
|
|
|
|
|
dup actor-expiry
|
|
|
|
|
[ millis <= [ dup remove-actor ] when ] when* drop ;
|
2005-11-15 03:19:57 -05:00
|
|
|
|
2005-11-19 04:09:30 -05:00
|
|
|
GENERIC: ai-tick
|
|
|
|
|
|
|
|
|
|
M: f ai-tick ( actor ai -- ) 2drop ;
|
|
|
|
|
|
2005-11-15 23:25:22 -05:00
|
|
|
: actor-tick ( time actor -- )
|
2005-11-19 04:09:30 -05:00
|
|
|
dup ?expire-actor dup ?collisions
|
|
|
|
|
dup dup actor-ai ai-tick
|
|
|
|
|
body-tick ;
|
2005-11-15 03:19:57 -05:00
|
|
|
|
|
|
|
|
: draw-actor ( actor -- )
|
|
|
|
|
GL_MODELVIEW [
|
|
|
|
|
dup body-position gl-translate
|
|
|
|
|
dup body-angle over body-up gl-rotate
|
|
|
|
|
dup body-size gl-scale
|
|
|
|
|
dup actor-colors swap actor-model draw-model
|
|
|
|
|
] do-matrix ;
|
|
|
|
|
|
2005-11-15 23:25:22 -05:00
|
|
|
: spawn-big-block ( position -- )
|
|
|
|
|
>r cube { { 1/2 1/2 1 1 } } r> 360 random-int { 3 3 3 } <actor> add-actor ;
|
|
|
|
|
|
2005-11-19 04:09:30 -05:00
|
|
|
: <player> ( position -- )
|
|
|
|
|
>r factoroid { { 1 0 0 1 } { 2/3 0 0 1 } } r> 0 { 3/4 1/4 2 } <actor> ;
|
2005-11-15 03:19:57 -05:00
|
|
|
|
|
|
|
|
: draw-actors
|
|
|
|
|
actors get [ draw-actor ] each ;
|
|
|
|
|
|
|
|
|
|
: tick-actors ( time -- )
|
2005-11-15 23:25:22 -05:00
|
|
|
actors get clone [ actor-tick ] each-with ;
|
