diff --git a/examples/factoroids/actors.factor b/examples/factoroids/actors.factor new file mode 100644 index 0000000000..241c3b49b4 --- /dev/null +++ b/examples/factoroids/actors.factor @@ -0,0 +1,109 @@ +USING: arrays gadgets generic hashtables io kernel math +namespaces opengl 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 ) + [ >r r> set-delegate ] keep + [ set-actor-colors ] keep + [ set-actor-model ] keep ; + +M: actor tick ( time actor -- ) + dup actor-expiry [ millis <= [ dup remove-actor ] when ] when* + delegate tick ; + +: 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 ; + +: init-actors + V{ } clone actors set + factoroid { { 1 0 0 1 } } { 25 1/2 25 } 0 { 3/4 1/2 1/2 } player set + player get add-actor ; + +: draw-actors + actors get [ draw-actor ] each ; + +: tick-actors ( time -- ) + actors get clone [ dupd tick ] each drop ; + +: 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 } + 1/2000 over set-body-acceleration 1000 add-expiring-actor ; diff --git a/examples/factoroids/factoroids.factor b/examples/factoroids/factoroids.factor new file mode 100644 index 0000000000..6c98c05a46 --- /dev/null +++ b/examples/factoroids/factoroids.factor @@ -0,0 +1,73 @@ +USING: arrays gadgets generic hashtables io kernel math +namespaces opengl sdl sequences styles threads ; +IN: factoroids + +: draw-sky + flat-projection + { 0 1 0 } { { 0 0 1/3 1 } { 2/3 2/3 1 1 } } { 1 1/2 0 } gl-gradient ; + +: make-sky-list ( -- id ) + GL_COMPILE [ draw-sky ] make-dlist ; + +: draw-ground + GL_DEPTH_TEST glDisable + black gl-color + GL_QUADS [ + { -1000 0 -1000 } gl-vertex + { -1000 0 1000 } gl-vertex + { 1000 0 1000 } gl-vertex + { 1000 0 -1000 } gl-vertex + ] do-state + GL_DEPTH_TEST glEnable ; + +: (grid-square) ( -- ) + GL_POINTS [ + 3 [ { 1 0 0 } n*v gl-vertex ] each + 3 [ { 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 + (grid-square) + ] do-matrix ; + +: draw-grid ( w h -- ) + white gl-color [ swap [ grid-square ] each-with ] each-with ; + +: make-ground-list ( -- id ) + GL_COMPILE [ draw-ground 50 50 draw-grid ] make-dlist ; + +SYMBOL: sky-list +SYMBOL: ground-list + +: init-dlists + make-sky-list sky-list set + make-ground-list ground-list set ; + +: draw-factoroids + [ + factoroids-gl + sky-list get glCallList + world-projection + player get camera-modelview + ground-list get glCallList + draw-actors + ] with-gl-surface ; + +SYMBOL: last-frame + +: advance-clock ( -- time ) + millis last-frame get over last-frame set - 30 min ; + +: run-game ( -- ) + advance-clock tick-actors + draw-factoroids + check-event [ run-game ] unless ; + +: factoroids + init-actors + 800 600 [ + init-dlists millis last-frame set run-game + ] with-gl-screen ; diff --git a/examples/factoroids/input.factor b/examples/factoroids/input.factor new file mode 100644 index 0000000000..9344611bcf --- /dev/null +++ b/examples/factoroids/input.factor @@ -0,0 +1,49 @@ +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 ; + +: 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 ( -- ? ) + dup SDL_PollEvent [ handle-event ] [ drop f ] if ; diff --git a/examples/factoroids/load.factor b/examples/factoroids/load.factor new file mode 100644 index 0000000000..6ce1db79cb --- /dev/null +++ b/examples/factoroids/load.factor @@ -0,0 +1,12 @@ +USING: io parser ; + +"examples/factoroids/utils.factor" run-file +"examples/factoroids/models.factor" run-file +"examples/factoroids/actors.factor" run-file +"examples/factoroids/input.factor" run-file +"examples/factoroids/factoroids.factor" run-file + +"To play Factoroids, enter the following in the listener:" print +terpri +" USE: factoroids" print +" factoroids" print diff --git a/examples/factoroids/models.factor b/examples/factoroids/models.factor new file mode 100644 index 0000000000..1e84e15ca0 --- /dev/null +++ b/examples/factoroids/models.factor @@ -0,0 +1,142 @@ +USING: arrays gadgets generic hashtables io kernel math +namespaces opengl sdl sequences threads ; +IN: factoroids + +TUPLE: face color normal polygon ; + +: draw-face ( colors face -- ) + [ face-color swap nth gl-color ] keep + ( dup face-normal gl-normal ) + face-polygon gl-fill-poly ; + +TUPLE: model faces ; + +: draw-model ( colors model -- ) + model-faces [ draw-face ] each-with ; + +: factoroid + T{ model f + { + T{ face f + 0 + { 0 0 -1 } + { + { -1/2 -1/2 -1/2 } + { 1/2 -1/2 -1/2 } + { 1/2 1/2 -1/2 } + { -1/2 1/2 -1/2 } + } + } + + T{ face f + 0 + { 0 0 1 } + { + { -1/2 -1/2 1/2 } + { 1/2 -1/2 1/2 } + { 1/2 1/2 1/2 } + { -1/2 1/2 1/2 } + } + } + + T{ face f + 0 + { -1 0 0 } + { + { -1/2 -1/2 -1/2 } + { -1/2 -1/2 1/2 } + { -1/2 1/2 1/2 } + { -1/2 1/2 -1/2 } + } + } + + T{ face f + 0 + { 1 0 0 } + { + { 1/2 -1/2 -1/2 } + { 1/2 -1/2 1/2 } + { 1/2 1/2 1/2 } + { 1/2 1/2 -1/2 } + } + } + + T{ face f + 0 + { 0 -1 0 } + { + { -1/2 -1/2 -1/2 } + { -1/2 -1/2 1/2 } + { 1/2 -1/2 1/2 } + { 1/2 -1/2 -1/2 } + } + } + + T{ face f + 0 + { 0 1 0 } + { + { -1/2 1/2 -1/2 } + { -1/2 1/2 1/2 } + { 1/2 1/2 1/2 } + { 1/2 1/2 -1/2 } + } + } + } + } ; + +: rocket + T{ model f + { + T{ face f + 0 + { 0 -1 0 } + { + { -1/2 0 -1/2 } + { 0 1/2 -1/2 } + { 1/2 0 -1/2 } + { 0 -1/2 -1/2 } + } + } + + T{ face f + 1 + f + { + { -1/2 0 -1/2 } + { 0 1/2 -1/2 } + { 0 0 1/2 } + } + } + + T{ face f + 1 + f + { + { 0 1/2 -1/2 } + { 1/2 0 -1/2 } + { 0 0 1/2 } + } + } + + T{ face f + 1 + f + { + { 1/2 0 -1/2 } + { 0 -1/2 -1/2 } + { 0 0 1/2 } + } + } + + T{ face f + 1 + f + { + { 0 -1/2 -1/2 } + { -1/2 0 -1/2 } + { 0 0 1/2 } + } + } + } + } ; diff --git a/examples/factoroids/utils.factor b/examples/factoroids/utils.factor new file mode 100644 index 0000000000..625ae07c09 --- /dev/null +++ b/examples/factoroids/utils.factor @@ -0,0 +1,37 @@ +IN: factoroids +USING: kernel math namespaces opengl sdl sequences ; + +: deg>rad pi * 180 / ; inline + +: rad>deg 180 * pi / ; inline + +: flat-projection + GL_PROJECTION glMatrixMode + glLoadIdentity + 0 1 1 0 gluOrtho2D + GL_DEPTH_TEST glDisable + GL_MODELVIEW glMatrixMode + glLoadIdentity ; + +: world-projection + GL_PROJECTION glMatrixMode + glLoadIdentity + 50 width get height get / 0.5 20 gluPerspective + GL_DEPTH_TEST glEnable + GL_MODELVIEW glMatrixMode + glLoadIdentity ; + +: factoroids-gl ( -- ) + 0.0 0.0 0.0 0.0 glClearColor + { 1.0 0.0 0.0 0.0 } gl-color + GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear + 0 0 width get height get glViewport + GL_SMOOTH glShadeModel + GL_PROJECTION glMatrixMode + glLoadIdentity ; + +: gl-normal ( normal -- ) first3 glNormal3d ; + +: gl-rotate first3 glRotated ; + +: gl-scale first3 glScaled ;