working on factoroids

examples/factoroids/actors.factor

@@ -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 -- )
+TUPLE: projectile owner ;
-    dup actor-expiry [ millis <= [ dup remove-actor ] when ] when*
+
-    delegate tick ;
+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 )
+: <rocket> ( position angle owner -- rocket )
-    >r >r rocket { { 1 1 0 1 } { 1 1 1 1 } } r> r> { 1/2 1/2 5 }
+    >r >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 ;
+    <actor> r> <projectile> 1/2000 over set-body-acceleration ;
+
+: spawn-rocket ( position angle owner -- )
+    <rocket> 1000 add-expiring-actor ;

examples/factoroids/bodies.factor

@@ -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 ;

examples/factoroids/factoroids.factor

@@ -22,14 +22,13 @@ IN: factoroids
 
 : (grid-square) ( -- )
     GL_POINTS [
-        3 [ { 1 0 0 } n*v gl-vertex ] each
+        5 [ { 1 0 0 } n*v gl-vertex ] each
-        3 [ { 0 0 1 } 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
+        [ 5 * ] 2apply 0 swap glTranslated
-        1/3 1/3 1/3 glScaled
         (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

examples/factoroids/input.factor

@@ -3,8 +3,10 @@ USING: generic hashtables io kernel math namespaces sdl
 sequences ;
 
 : fire ( -- )
-    player get dup body-position over body-direction 3 v*n v+
+    player get [
-    swap body-angle spawn-rocket ;
+        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

examples/factoroids/load.factor

@@ -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

examples/factoroids/models.factor

@@ -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
         {

examples/factoroids/utils.factor

@@ -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 ;