113 lines
2.5 KiB
Factor
113 lines
2.5 KiB
Factor
! 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
|
|
|
|
SYMBOL: rotation
|
|
|
|
: update-matrix
|
|
theta get rotation-matrix-1
|
|
phi get rotation-matrix-2 m.
|
|
psi get rotation-matrix-3 m. rotation set ;
|
|
|
|
: >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
|