rotating cube example added

examples/cube3d.factor

@@ -0,0 +1,112 @@
+! Rotating 3d cube.
+!
+! To run this code, bootstrap Factor like so:
+!
+! ./f boot.image.le32
+!     -libraries:sdl:name=libSDL.so
+!     -libraries:sdl-gfx:name=libSDL_gfx.so
+!
+! (But all on one line)
+!
+! Then, start Factor as usual (./f factor.image) and enter this
+! at the listener:
+!
+! "examples/cube3d.factor" run-file
+
+IN: cube3d
+USING: compiler kernel lists math matrices namespaces sdl
+sequences ;
+
+! A 2x2x2 cube.
+: points
+    [
+        [[ { 1 1 1 } { 1 1 -1 } ]]
+        [[ { 1 1 1 } { 1 -1 1 } ]]
+        [[ { 1 1 1 } { -1 1 1 } ]]
+        [[ { -1 1 1 } { -1 1 -1 } ]]
+        [[ { -1 1 1 } { -1 -1 1 } ]]
+        [[ { 1 -1 1 } { -1 -1 1 } ]]
+        [[ { 1 -1 1 } { 1 -1 -1 } ]]
+        [[ { 1 1 -1 } { -1 1 -1 } ]]
+        [[ { 1 1 -1 } { 1 -1 -1 } ]]
+        [[ { -1 1 -1 } { -1 -1 -1 } ]]
+        [[ { -1 -1 1 } { -1 -1 -1 } ]]
+        [[ { 1 -1 -1 } { -1 -1 -1 } ]]
+    ] ;
+
+: 3vector ( x y z -- { x y z } )
+    [ rot , swap , , ] make-vector ;
+
+: rotation-matrix-1 ( theta -- )
+    [
+        dup cos ,     dup sin , 0 ,
+        dup sin neg , cos ,     0 ,
+        0 ,           0 ,       1 ,
+    ] make-vector 3 3 rot <matrix> ;
+
+: rotation-matrix-2 ( theta -- )
+    [
+        1 , 0 ,           0 ,
+        0 , dup cos ,     dup sin ,
+        0 , dup sin neg , cos ,
+    ] make-vector 3 3 rot <matrix> ;
+
+: rotation-matrix-3 ( theta -- )
+    [
+        dup cos , 0 , dup sin neg ,
+        0 ,       1 , 0 ,
+        dup sin , 0 , cos ,
+    ] make-vector 3 3 rot <matrix> ;
+
+SYMBOL: theta
+SYMBOL: phi
+SYMBOL: psi
+
+: update-matrix
+    theta get rotation-matrix-1
+    phi get rotation-matrix-2 m.
+    psi get rotation-matrix-3 m. rotation set ;
+
+SYMBOL: rotation
+
+: >scene ( { x y z } -- { x y z } )
+    rotation get swap m.v ;
+
+: >screen ( { x y z } -- x y )
+    200 swap n*v width get 2 / height get 2 / 0 3vector v+
+    0 over nth 1 rot nth ;
+
+: redraw ( -- )
+    surface get 0 0 width get height get black rgb boxColor
+    points [
+        uncons >r >r surface get
+        r> >scene >screen
+        r> >scene >screen
+        red rgb lineColor
+    ] each ;
+
+: event-loop ( event -- )
+    theta [ 0.01 + ] change
+    phi [ 0.02 + ] change
+    psi [ 0.03 + ] change
+    update-matrix
+    [ redraw ] with-surface
+    dup SDL_PollEvent [
+        dup event-type SDL_QUIT = [
+            drop
+        ] [
+            event-loop
+        ] ifte
+    ] [
+        event-loop
+    ] ifte ;
+
+: cube3d ( -- )
+    800 600 0 SDL_HWSURFACE [
+        0 theta set
+        0 phi set
+        0 psi set
+        <event> event-loop SDL_Quit
+    ] with-screen ;
+
+cube3d