working on factoroids
Slava Pestov
parent
036d1f9673
commit
e640958e12
|
|
@ -1,76 +1,14 @@
|
|||
USING: arrays gadgets generic hashtables io kernel math
|
||||
namespaces opengl sdl sequences threads ;
|
||||
namespaces opengl prettyprint sdl sequences threads ;
|
||||
IN: factoroids
|
||||
|
||||
SYMBOL: player
|
||||
|
||||
SYMBOL: actors
|
||||
|
||||
: add-actor dup actors get push ;
|
||||
|
||||
: remove-actor actors get delete ;
|
||||
|
||||
TUPLE: body position velocity acceleration size up angle angle-delta direction ;
|
||||
|
||||
GENERIC: tick ( time obj -- )
|
||||
|
||||
: update-direction ( body -- )
|
||||
dup body-angle deg>rad dup sin swap cos 0 swap 3array
|
||||
swap set-body-direction ;
|
||||
|
||||
C: body ( position angle size -- )
|
||||
[ set-body-size ] keep
|
||||
[ set-body-angle ] keep
|
||||
[ set-body-position ] keep
|
||||
{ 0 1 0 } over set-body-up
|
||||
0 over set-body-velocity
|
||||
0 over set-body-acceleration
|
||||
0 over set-body-angle-delta
|
||||
dup update-direction ;
|
||||
|
||||
: scaled-angle-delta ( time body -- x ) body-angle-delta * ;
|
||||
|
||||
: scaled-acceleration ( time body -- x ) body-acceleration * ;
|
||||
|
||||
: scaled-velocity ( time body -- x )
|
||||
[ body-velocity * ] keep body-direction n*v ;
|
||||
|
||||
: friction 0.95 ;
|
||||
|
||||
: update-angle ( time body -- )
|
||||
[ [ scaled-angle-delta ] keep body-angle + ] keep
|
||||
set-body-angle ;
|
||||
|
||||
: update-velocity ( time body -- )
|
||||
[
|
||||
[ scaled-acceleration ] keep body-velocity + friction *
|
||||
] keep set-body-velocity ;
|
||||
|
||||
: update-position ( time body -- )
|
||||
[ [ scaled-velocity ] keep body-position v+ ] keep
|
||||
set-body-position ;
|
||||
|
||||
M: body tick ( time body -- )
|
||||
[ update-angle ] 2keep
|
||||
[ update-velocity ] 2keep
|
||||
[ update-position ] keep
|
||||
update-direction ;
|
||||
|
||||
: camera-position ( player -- vec )
|
||||
dup body-position swap body-direction 3 v*n v- { 0 1 0 } v+ ;
|
||||
|
||||
: camera-look-at ( player -- vec )
|
||||
dup body-position swap body-direction 3 v*n v+ ;
|
||||
|
||||
: camera-modelview ( player -- )
|
||||
GL_MODELVIEW glMatrixMode
|
||||
glLoadIdentity
|
||||
dup camera-position
|
||||
over camera-look-at
|
||||
rot body-up
|
||||
>r >r first3 r> first3 r> first3
|
||||
gluLookAt ;
|
||||
|
||||
TUPLE: actor model colors up expiry ;
|
||||
|
||||
C: actor ( model colors position angle size -- actor )
|
||||
|
|
@ -78,9 +16,46 @@ C: actor ( model colors position angle size -- actor )
|
|||
[ set-actor-colors ] keep
|
||||
[ set-actor-model ] keep ;
|
||||
|
||||
M: actor tick ( time actor -- )
|
||||
dup actor-expiry [ millis <= [ dup remove-actor ] when ] when*
|
||||
delegate tick ;
|
||||
TUPLE: projectile owner ;
|
||||
|
||||
C: projectile ( actor owner -- projectile )
|
||||
[ set-projectile-owner ] keep
|
||||
[ set-delegate ] keep ;
|
||||
|
||||
GENERIC: can-collide* ( actor actor -- ? )
|
||||
|
||||
M: projectile can-collide* ( actor actor -- ? )
|
||||
over projectile? >r projectile-owner eq? r> or not ;
|
||||
|
||||
M: actor can-collide* ( actor actor -- ) 2drop t ;
|
||||
|
||||
GENERIC: collision
|
||||
|
||||
M: actor collision ( actor actor -- ) drop remove-actor ;
|
||||
|
||||
: can-collide? ( actor actor -- ? )
|
||||
2dup eq? [
|
||||
2drop f
|
||||
] [
|
||||
2dup can-collide* >r swap can-collide* r> and
|
||||
] if ;
|
||||
|
||||
: collidable ( actor -- seq )
|
||||
actors get [ can-collide? ] subset-with ;
|
||||
|
||||
: ?collision ( actor actor -- )
|
||||
2dup [ body-position ] 2apply v- norm 2 <=
|
||||
[ 2dup collision 2dup swap collision ] when 2drop ;
|
||||
|
||||
: ?collisions ( actor -- )
|
||||
dup collidable [ ?collision ] each-with ;
|
||||
|
||||
: ?expire-actor
|
||||
dup actor-expiry
|
||||
[ millis <= [ dup remove-actor ] when ] when* drop ;
|
||||
|
||||
: actor-tick ( time actor -- )
|
||||
dup ?expire-actor dup ?collisions body-tick ;
|
||||
|
||||
: draw-actor ( actor -- )
|
||||
GL_MODELVIEW [
|
||||
|
|
@ -90,20 +65,30 @@ M: actor tick ( time actor -- )
|
|||
dup actor-colors swap actor-model draw-model
|
||||
] do-matrix ;
|
||||
|
||||
: spawn-big-block ( position -- )
|
||||
>r cube { { 1/2 1/2 1 1 } } r> 360 random-int { 3 3 3 } <actor> add-actor ;
|
||||
|
||||
: init-actors
|
||||
V{ } clone actors set
|
||||
factoroid { { 1 0 0 1 } } { 25 1/2 25 } 0 { 3/4 1/2 1/2 } <actor> player set
|
||||
{ 15 3 25 } spawn-big-block
|
||||
{ 20 2 25 } spawn-big-block
|
||||
{ 30 1 20 } spawn-big-block
|
||||
{ 30 1/2 15 } spawn-big-block
|
||||
factoroid { { 1 0 0 1 } { 2/3 0 0 1 } } { 25 1/2 25 } 0 { 3/4 1/4 2 } <actor> player set
|
||||
player get add-actor ;
|
||||
|
||||
: draw-actors
|
||||
actors get [ draw-actor ] each ;
|
||||
|
||||
: tick-actors ( time -- )
|
||||
actors get clone [ dupd tick ] each drop ;
|
||||
actors get clone [ actor-tick ] each-with ;
|
||||
|
||||
: add-expiring-actor ( actor time-to-live -- )
|
||||
millis + over set-actor-expiry add-actor ;
|
||||
|
||||
: spawn-rocket ( position angle -- rocket )
|
||||
>r >r rocket { { 1 1 0 1 } { 1 1 1 1 } } r> r> { 1/2 1/2 5 }
|
||||
<actor> 1/2000 over set-body-acceleration 1000 add-expiring-actor ;
|
||||
: <rocket> ( position angle owner -- rocket )
|
||||
>r >r >r rocket { { 1 1 0 1 } { 1 1 1 1 } } r> r> { 1/2 1/2 5 }
|
||||
<actor> r> <projectile> 1/2000 over set-body-acceleration ;
|
||||
|
||||
: spawn-rocket ( position angle owner -- )
|
||||
<rocket> 1000 add-expiring-actor ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,65 @@
|
|||
USING: arrays gadgets generic hashtables io kernel math
|
||||
namespaces opengl sdl sequences threads ;
|
||||
IN: factoroids
|
||||
|
||||
TUPLE: body position velocity acceleration size up angle
|
||||
angle-delta direction ;
|
||||
|
||||
GENERIC: tick ( time obj -- )
|
||||
|
||||
: update-direction ( body -- )
|
||||
dup body-angle deg>rad dup sin swap cos 0 swap 3array
|
||||
swap set-body-direction ;
|
||||
|
||||
C: body ( position angle size -- )
|
||||
[ set-body-size ] keep
|
||||
[ set-body-angle ] keep
|
||||
[ set-body-position ] keep
|
||||
{ 0 1 0 } over set-body-up
|
||||
0 over set-body-velocity
|
||||
0 over set-body-acceleration
|
||||
0 over set-body-angle-delta
|
||||
dup update-direction ;
|
||||
|
||||
: scaled-angle-delta ( time body -- x ) body-angle-delta * ;
|
||||
|
||||
: scaled-acceleration ( time body -- x ) body-acceleration * ;
|
||||
|
||||
: scaled-velocity ( time body -- x )
|
||||
[ body-velocity * ] keep body-direction n*v ;
|
||||
|
||||
: friction 0.95 ;
|
||||
|
||||
: update-angle ( time body -- )
|
||||
[ [ scaled-angle-delta ] keep body-angle + ] keep
|
||||
set-body-angle ;
|
||||
|
||||
: update-velocity ( time body -- )
|
||||
[
|
||||
[ scaled-acceleration ] keep body-velocity + friction *
|
||||
] keep set-body-velocity ;
|
||||
|
||||
: update-position ( time body -- )
|
||||
[ [ scaled-velocity ] keep body-position v+ ] keep
|
||||
set-body-position ;
|
||||
|
||||
: body-tick ( time body -- )
|
||||
[ update-angle ] 2keep
|
||||
[ update-velocity ] 2keep
|
||||
[ update-position ] keep
|
||||
update-direction ;
|
||||
|
||||
: camera-position ( player -- vec )
|
||||
dup body-position swap body-direction 3 v*n v- { 0 1 0 } v+ ;
|
||||
|
||||
: camera-look-at ( player -- vec )
|
||||
dup body-position swap body-direction 2 v*n v+ ;
|
||||
|
||||
: camera-modelview ( player -- )
|
||||
GL_MODELVIEW glMatrixMode
|
||||
glLoadIdentity
|
||||
dup camera-position
|
||||
over camera-look-at
|
||||
rot body-up
|
||||
>r >r first3 r> first3 r> first3
|
||||
gluLookAt ;
|
||||
|
|
@ -22,14 +22,13 @@ IN: factoroids
|
|||
|
||||
: (grid-square) ( -- )
|
||||
GL_POINTS [
|
||||
3 [ { 1 0 0 } n*v gl-vertex ] each
|
||||
3 [ { 0 0 1 } n*v gl-vertex ] each
|
||||
5 [ { 1 0 0 } n*v gl-vertex ] each
|
||||
5 [ { 0 0 1 } n*v gl-vertex ] each
|
||||
] do-state ;
|
||||
|
||||
: grid-square ( w h -- )
|
||||
GL_MODELVIEW [
|
||||
0 swap glTranslated
|
||||
1/3 1/3 1/3 glScaled
|
||||
[ 5 * ] 2apply 0 swap glTranslated
|
||||
(grid-square)
|
||||
] do-matrix ;
|
||||
|
||||
|
|
@ -64,6 +63,7 @@ SYMBOL: last-frame
|
|||
: run-game ( -- )
|
||||
advance-clock tick-actors
|
||||
draw-factoroids
|
||||
2 sleep
|
||||
check-event [ run-game ] unless ;
|
||||
|
||||
: factoroids
|
||||
|
|
|
|||
|
|
@ -2,9 +2,11 @@ IN: factoroids
|
|||
USING: generic hashtables io kernel math namespaces sdl
|
||||
sequences ;
|
||||
|
||||
: fire ( -- )
|
||||
player get dup body-position over body-direction 3 v*n v+
|
||||
swap body-angle spawn-rocket ;
|
||||
: 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
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@ USING: io parser ;
|
|||
|
||||
"examples/factoroids/utils.factor" run-file
|
||||
"examples/factoroids/models.factor" run-file
|
||||
"examples/factoroids/bodies.factor" run-file
|
||||
"examples/factoroids/actors.factor" run-file
|
||||
"examples/factoroids/input.factor" run-file
|
||||
"examples/factoroids/factoroids.factor" run-file
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ TUPLE: model faces ;
|
|||
: draw-model ( colors model -- )
|
||||
model-faces [ draw-face ] each-with ;
|
||||
|
||||
: factoroid
|
||||
: cube
|
||||
T{ model f
|
||||
{
|
||||
T{ face f
|
||||
|
|
@ -85,6 +85,62 @@ TUPLE: model faces ;
|
|||
}
|
||||
} ;
|
||||
|
||||
: factoroid
|
||||
T{ model f
|
||||
{
|
||||
T{ face f
|
||||
1
|
||||
f
|
||||
{
|
||||
{ -1/3 1/2 -1/2 }
|
||||
{ 1/3 1/2 -1/2 }
|
||||
{ 1/2 -1/2 -1/2 }
|
||||
{ -1/2 -1/2 -1/2 }
|
||||
}
|
||||
}
|
||||
|
||||
T{ face f
|
||||
0
|
||||
f
|
||||
{
|
||||
{ -1/3 1/2 -1/2 }
|
||||
{ -1/2 -1/2 -1/2 }
|
||||
{ 0 -1/2 1/2 }
|
||||
}
|
||||
}
|
||||
|
||||
T{ face f
|
||||
0
|
||||
f
|
||||
{
|
||||
{ 1/3 1/2 -1/2 }
|
||||
{ 1/2 -1/2 -1/2 }
|
||||
{ 0 -1/2 1/2 }
|
||||
}
|
||||
}
|
||||
|
||||
T{ face f
|
||||
0
|
||||
f
|
||||
{
|
||||
{ -1/3 1/2 -1/2 }
|
||||
{ 1/3 1/2 -1/2 }
|
||||
{ 0 -1/2 1/2 }
|
||||
}
|
||||
}
|
||||
|
||||
T{ face f
|
||||
0
|
||||
f
|
||||
{
|
||||
{ -1/2 -1/2 -1/2 }
|
||||
{ -1/2 -1/2 -1/2 }
|
||||
{ 0 -1/2 1/2 }
|
||||
}
|
||||
}
|
||||
}
|
||||
} ;
|
||||
|
||||
: rocket
|
||||
T{ model f
|
||||
{
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
IN: factoroids
|
||||
USING: kernel math namespaces opengl sdl sequences ;
|
||||
USING: alien kernel math namespaces opengl sdl sequences ;
|
||||
|
||||
: deg>rad pi * 180 / ; inline
|
||||
|
||||
|
|
@ -11,12 +11,26 @@ USING: kernel math namespaces opengl sdl sequences ;
|
|||
0 1 1 0 gluOrtho2D
|
||||
GL_DEPTH_TEST glDisable
|
||||
GL_MODELVIEW glMatrixMode
|
||||
glLoadIdentity ;
|
||||
glLoadIdentity
|
||||
GL_LIGHTING glDisable
|
||||
;
|
||||
|
||||
: >float-array ( seq -- float-array )
|
||||
dup length dup <float-array> -rot
|
||||
[ pick set-float-nth ] 2each ;
|
||||
|
||||
: light-source
|
||||
GL_LIGHTING glEnable
|
||||
GL_LIGHT0 glEnable
|
||||
GL_LIGHT0 GL_POSITION { 1 1 1 0 } >float-array glLightfv
|
||||
GL_LIGHT0 GL_DIFFUSE { 1 0 0 1 } >float-array glLightfv
|
||||
GL_LIGHT0 GL_SPECULAR { 1 1 1 1 } >float-array glLightfv
|
||||
GL_LIGHT0 GL_AMBIENT { 0.1 0.1 0.1 1 } >float-array glLightfv ;
|
||||
|
||||
: world-projection
|
||||
GL_PROJECTION glMatrixMode
|
||||
glLoadIdentity
|
||||
50 width get height get / 0.5 20 gluPerspective
|
||||
50 width get height get / 1 30 gluPerspective
|
||||
GL_DEPTH_TEST glEnable
|
||||
GL_MODELVIEW glMatrixMode
|
||||
glLoadIdentity ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue