steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

golden-section: revisit a few items

db4
Eduardo Cavazos 2008-07-18 17:14:23 -05:00
parent f65e97b266
commit a2eb8a0431
1 changed files with 34 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
extra/golden-section/golden-section.factor
View File

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