2004-11-09 12:25:13 -05:00
|
|
|
! DeJong attractor renderer.
|
|
|
|
!
|
2004-12-25 18:08:20 -05:00
|
|
|
! To run this code, bootstrap Factor like so:
|
2004-11-09 12:25:13 -05:00
|
|
|
!
|
2004-12-25 18:08:20 -05:00
|
|
|
! ./f boot.image.le32
|
|
|
|
! -libraries:sdl:name=libSDL.so
|
2005-01-20 23:10:37 -05:00
|
|
|
! -libraries:sdl-gfx:name=libSDL_gfx.so
|
2004-12-25 18:08:20 -05:00
|
|
|
!
|
|
|
|
! (But all on one line)
|
|
|
|
!
|
|
|
|
! Then, start Factor as usual (./f factor.image) and enter this
|
|
|
|
! at the listener:
|
2004-11-09 12:25:13 -05:00
|
|
|
!
|
2004-11-20 16:57:01 -05:00
|
|
|
! "examples/dejong.factor" run-file
|
2004-11-09 12:25:13 -05:00
|
|
|
|
|
|
|
! For details on DeJong attractors, see
|
|
|
|
! http://www.complexification.net/gallery/machines/peterdejong/
|
|
|
|
|
|
|
|
IN: dejong
|
2005-07-22 23:39:28 -04:00
|
|
|
USING: compiler kernel math namespaces sdl styles test ;
|
2004-11-09 12:25:13 -05:00
|
|
|
|
|
|
|
SYMBOL: a
|
|
|
|
SYMBOL: b
|
|
|
|
SYMBOL: c
|
|
|
|
SYMBOL: d
|
|
|
|
|
|
|
|
: next-x ( x y -- x ) a get * sin swap b get * cos - ;
|
|
|
|
: next-y ( x y -- y ) swap c get * sin swap d get * cos - ;
|
|
|
|
|
2005-01-14 12:01:48 -05:00
|
|
|
: pixel ( #{ x y }# color -- )
|
2004-11-09 12:25:13 -05:00
|
|
|
>r >r surface get r> >rect r> pixelColor ;
|
|
|
|
|
|
|
|
: iterate-dejong ( x y -- x y )
|
|
|
|
2dup next-y >r next-x r> ;
|
|
|
|
|
|
|
|
: scale-dejong ( x y -- x y )
|
|
|
|
swap width get 4 / * width get 2 / + >fixnum
|
|
|
|
swap height get 4 / * height get 2 / + >fixnum ;
|
|
|
|
|
|
|
|
: draw-dejong ( x0 y0 iterations -- )
|
|
|
|
[
|
2005-01-23 16:47:28 -05:00
|
|
|
iterate-dejong 2dup scale-dejong rect> white rgb pixel
|
2005-01-20 23:10:37 -05:00
|
|
|
] times 2drop ; compiled
|
2004-11-09 12:25:13 -05:00
|
|
|
|
2005-03-06 20:03:22 -05:00
|
|
|
: event-loop ( event -- )
|
|
|
|
dup SDL_WaitEvent [
|
|
|
|
dup event-type SDL_QUIT = [
|
|
|
|
drop
|
|
|
|
] [
|
|
|
|
event-loop
|
|
|
|
] ifte
|
|
|
|
] [
|
|
|
|
drop
|
|
|
|
] ifte ; compiled
|
|
|
|
|
2004-11-09 12:25:13 -05:00
|
|
|
: dejong ( -- )
|
|
|
|
! Fiddle with these four values!
|
2005-01-20 23:10:37 -05:00
|
|
|
1.0 a set
|
|
|
|
-1.3 b set
|
|
|
|
0.8 c set
|
2004-11-09 12:25:13 -05:00
|
|
|
-2.1 d set
|
|
|
|
|
2005-04-24 00:27:07 -04:00
|
|
|
800 600 0 SDL_HWSURFACE [
|
2005-01-20 23:10:37 -05:00
|
|
|
[ 0 0 200000 [ draw-dejong ] time ] with-surface
|
2004-11-09 12:25:13 -05:00
|
|
|
|
|
|
|
<event> event-loop
|
|
|
|
SDL_Quit
|
2005-01-20 23:10:37 -05:00
|
|
|
] with-screen ;
|
2004-11-09 12:25:13 -05:00
|
|
|
|
2005-01-20 23:10:37 -05:00
|
|
|
dejong
|