diff --git a/extra/golden-section/golden-section.factor b/extra/golden-section/golden-section.factor index 354d4d9116..8ae8bccc25 100644 --- a/extra/golden-section/golden-section.factor +++ b/extra/golden-section/golden-section.factor @@ -1,64 +1,64 @@ + 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 ; + opengl opengl.gl opengl.glu ui ui.render ui.gadgets ui.gadgets.theme + ui.gadgets.slate colors accessors combinators.cleave ; + IN: golden-section ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! To run: -! "golden-section" run +: disk ( radius center -- ) + glPushMatrix + gl-translate + dup 0 glScalef + gluNewQuadric [ 0 1 20 20 gluDisk ] [ gluDeleteQuadric ] bi + glPopMatrix ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: disk ( quadric radius center -- ) - glPushMatrix - gl-translate - dup 0 glScalef - 0 1 10 10 gluDisk - glPopMatrix ; +! omega(i) = 2*pi*i*(phi-1) + +! x(i) = 0.5*i*cos(omega(i)) +! y(i) = 0.5*i*sin(omega(i)) + +! radius(i) = 10*sin((pi*i)/720) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : 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 ) dup x swap y 2array ; +: center ( i -- point ) { x y } 1arr ; : 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 ; +: rim ( i -- ) [ drop black gl-color ] [ radius 1.5 * ] [ center ] tri disk ; +: inner ( i -- ) [ color gl-color ] [ radius ] [ center ] tri disk ; -: inner ( quadric i -- ) - dup color gl-color dup radius swap center disk ; +: dot ( i -- ) [ rim ] [ inner ] bi ; -: dot ( quadric i -- ) 2dup rim inner ; - -: golden-section ( quadric -- ) 720 [ dot ] with each ; +: golden-section ( -- ) 720 [ dot ] 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 ; + GL_PROJECTION glMatrixMode + glLoadIdentity + -400 400 -400 400 -1 1 glOrtho + GL_MODELVIEW glMatrixMode + glLoadIdentity + golden-section ; : golden-section-window ( -- ) [ - [ display ] - { 600 600 } over set-slate-pdim - "Golden Section" open-window - ] with-ui ; + [ display ] + { 600 600 } >>pdim + "Golden Section" open-window + ] + with-ui ; MAIN: golden-section-window