65 lines
1.6 KiB
Factor
65 lines
1.6 KiB
Factor
USING: kernel namespaces math math.constants math.functions arrays sequences
|
|
opengl opengl.gl opengl.glu ui ui.render ui.gadgets ui.gadgets.theme
|
|
ui.gadgets.slate colors ;
|
|
IN: golden-section
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
! To run:
|
|
! "golden-section" run
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
: disk ( quadric radius center -- )
|
|
glPushMatrix
|
|
gl-translate
|
|
dup 0 glScalef
|
|
0 1 10 10 gluDisk
|
|
glPopMatrix ;
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
: omega ( i -- omega ) phi 1- * 2 * pi * ;
|
|
|
|
: x ( i -- x ) dup omega cos * 0.5 * ;
|
|
|
|
: y ( i -- y ) dup omega sin * 0.5 * ;
|
|
|
|
: center ( i -- point ) dup x swap y 2array ;
|
|
|
|
: radius ( i -- radius ) pi * 720 / sin 10 * ;
|
|
|
|
: color ( i -- color ) 360.0 / dup 0.25 1 4array ;
|
|
|
|
: rim ( quadric i -- )
|
|
black gl-color dup radius 1.5 * swap center disk ;
|
|
|
|
: inner ( quadric i -- )
|
|
dup color gl-color dup radius swap center disk ;
|
|
|
|
: dot ( quadric i -- ) 2dup rim inner ;
|
|
|
|
: golden-section ( quadric -- ) 720 [ dot ] with each ;
|
|
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
: with-quadric ( quot -- )
|
|
gluNewQuadric [ swap call ] keep gluDeleteQuadric ; inline
|
|
|
|
: display ( -- )
|
|
GL_PROJECTION glMatrixMode
|
|
glLoadIdentity
|
|
-400 400 -400 400 -1 1 glOrtho
|
|
GL_MODELVIEW glMatrixMode
|
|
glLoadIdentity
|
|
[ golden-section ] with-quadric ;
|
|
|
|
: golden-section-window ( -- )
|
|
[
|
|
[ display ] <slate>
|
|
{ 600 600 } over set-slate-dim
|
|
"Golden Section" open-window
|
|
] with-ui ;
|
|
|
|
MAIN: golden-section-window
|