golden-section: revisit a few items

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 ] <slate>
-        { 600 600 } over set-slate-pdim
-        "Golden Section" open-window
-    ] with-ui ;
+      [ display ] <slate>
+        { 600 600 } >>pdim
+      "Golden Section" open-window
+    ]
+  with-ui ;
 
 MAIN: golden-section-window